freepascal.compiler/packages/fcl-xml/src/dom.pp

{
    This file is part of the Free Component Library

    Implementation of DOM interfaces
    Copyright (c) 1999-2000 by Sebastian Guenther, [email protected]
    Modified in 2006 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.

 **********************************************************************}

{
  This unit provides classes which implement the interfaces defined in the
  DOM (Document Object Model) specification.
  The current state is:
  DOM Levels 1 and 2 -  Completely implemented
  DOM Level 3  -  Partially implemented

  Specification used for this implementation:

  "Document Object Model (DOM) Level 2 Specification Version 1.0
   W3C Recommendation 11 November, 2000"
   http://www.w3.org/TR/2000/REC-DOM-Level-2-Core-20001113
}


unit DOM;

{$ifdef fpc}
{$MODE objfpc}{$H+}
{$endif}

interface

uses
  SysUtils, Classes, xmlutils, dtdmodel;

// -------------------------------------------------------
//   DOMException
// -------------------------------------------------------

const

  // DOM Level 1 exception codes:

  INDEX_SIZE_ERR              = 1;  // index or size is negative, or greater than the allowed value
  DOMSTRING_SIZE_ERR          = 2;  // Specified range of text does not fit into a DOMString
  HIERARCHY_REQUEST_ERR       = 3;  // node is inserted somewhere it does not belong
  WRONG_DOCUMENT_ERR          = 4;  // node is used in a different document than the one that created it (that does not support it)
  INVALID_CHARACTER_ERR       = 5;  // invalid or illegal character is specified, such as in a name
  NO_DATA_ALLOWED_ERR         = 6;  // data is specified for a node which does not support data
  NO_MODIFICATION_ALLOWED_ERR = 7;  // an attempt is made to modify an object where modifications are not allowed
  NOT_FOUND_ERR               = 8;  // an attempt is made to reference a node in a context where it does not exist
  NOT_SUPPORTED_ERR           = 9;  // implementation does not support the type of object requested
  INUSE_ATTRIBUTE_ERR         = 10;  // an attempt is made to add an attribute that is already in use elsewhere

  // DOM Level 2 exception codes:

  INVALID_STATE_ERR           = 11;  // an attempt is made to use an object that is not, or is no longer, usable
  SYNTAX_ERR                  = 12;  // invalid or illegal string specified
  INVALID_MODIFICATION_ERR    = 13;  // an attempt is made to modify the type of the underlying object
  NAMESPACE_ERR               = 14;  // an attempt is made to create or change an object in a way which is incorrect with regard to namespaces
  INVALID_ACCESS_ERR          = 15;  // parameter or operation is not supported by the underlying object

// -------------------------------------------------------
//   Node
// -------------------------------------------------------

const
  ELEMENT_NODE = 1;
  ATTRIBUTE_NODE = 2;
  TEXT_NODE = 3;
  CDATA_SECTION_NODE = 4;
  ENTITY_REFERENCE_NODE = 5;
  ENTITY_NODE = 6;
  PROCESSING_INSTRUCTION_NODE = 7;
  COMMENT_NODE = 8;
  DOCUMENT_NODE = 9;
  DOCUMENT_TYPE_NODE = 10;
  DOCUMENT_FRAGMENT_NODE = 11;
  NOTATION_NODE = 12;

type
  TDOMDocument = class;
  TDOMNodeList = class;
  TDOMNamedNodeMap = class;
  TDOMAttr = class;
  TDOMElement = class;
  TDOMText = class;
  TDOMComment = class;
  TDOMCDATASection = class;
  TDOMDocumentType = class;
  TDOMEntityReference = class;
  TDOMProcessingInstruction = class;

  TNodePool = class;
  PNodePoolArray = ^TNodePoolArray;
{$ifdef CPU16}
  TNodePoolArray = array[0..MaxSmallInt div sizeof(Pointer)-1] of TNodePool;
{$else CPU16}
  TNodePoolArray = array[0..MaxInt div sizeof(Pointer)-1] of TNodePool;
{$endif CPU16}

{$ifndef fpc}
  TFPList = TList;
{$endif}

// -------------------------------------------------------
//   DOMString
// -------------------------------------------------------

  TSetOfChar = xmlutils.TSetOfChar;  { to be removed: not used in DOM unit }
  DOMString = XMLString;
  DOMPChar = PXMLChar;
  PDOMString = ^DOMString;

  EDOMError = class(Exception)
  public
    Code: Integer;
    constructor Create(ACode: Integer; const ASituation: String);
  end;

  EDOMIndexSize = class(EDOMError)
  public
    constructor Create(const ASituation: String);
  end;

  EDOMHierarchyRequest = class(EDOMError)
  public
    constructor Create(const ASituation: String);
  end;

  EDOMWrongDocument = class(EDOMError)
  public
    constructor Create(const ASituation: String);
  end;

  EDOMNotFound = class(EDOMError)
  public
    constructor Create(const ASituation: String);
  end;

  EDOMNotSupported = class(EDOMError)
  public
    constructor Create(const ASituation: String);
  end;

  EDOMInUseAttribute = class(EDOMError)
  public
    constructor Create(const ASituation: String);
  end;

  EDOMInvalidState = class(EDOMError)
  public
    constructor Create(const ASituation: String);
  end;

  EDOMSyntax = class(EDOMError)
  public
    constructor Create(const ASituation: String);
  end;

  EDOMInvalidModification = class(EDOMError)
  public
    constructor Create(const ASituation: String);
  end;

  EDOMNamespace = class(EDOMError)
  public
    constructor Create(const ASituation: String);
  end;

  EDOMInvalidAccess = class(EDOMError)
  public
    constructor Create(const ASituation: String);
  end;

{ NodeType, NodeName and NodeValue had been moved from fields to functions.
  This lowers memory usage and also obsoletes most constructors,
  at a slight performance penalty. However, NodeName and NodeValue are
  accessible via fields using specialized properties of descendant classes,
  e.g. TDOMElement.TagName, TDOMCharacterData.Data etc.}

  TNodeFlagEnum = (
    nfReadonly,
    nfRecycled,
    nfLevel2,
    nfIgnorableWS,
    nfSpecified,
    nfDestroying,
    nfFirstChild
  );
  TNodeFlags = set of TNodeFlagEnum;

  TDOMNode = class
  protected
    FPool: TObject;
    FFlags: TNodeFlags;
    FParentNode: TDOMNode;
    FPreviousSibling, FNextSibling: TDOMNode;
    FOwnerDocument: TDOMDocument;

    function  GetNodeName: DOMString; virtual; abstract;
    function  GetNodeValue: DOMString; virtual;
    function  GetParentNode: TDOMNode; virtual;
    procedure SetNodeValue(const AValue: DOMString); virtual;
    function  GetFirstChild: TDOMNode; virtual;
    function  GetLastChild: TDOMNode; virtual;
    function  GetPreviousSibling: TDOMNode; virtual;
    function  GetAttributes: TDOMNamedNodeMap; virtual;
    function GetRevision: Integer;
    function GetNodeType: Integer; virtual; abstract;
    function GetTextContent: DOMString; virtual;
    procedure SetTextContent(const AValue: DOMString); virtual;
    function GetLocalName: DOMString; virtual;
    function GetNamespaceURI: DOMString; virtual;
    function GetPrefix: DOMString; virtual;
    procedure SetPrefix(const Value: DOMString); virtual;
    function GetOwnerDocument: TDOMDocument; virtual;
    function GetBaseURI: DOMString;
    procedure Changing;
  public
    constructor Create(AOwner: TDOMDocument);
    destructor Destroy; override;
    procedure FreeInstance; override;

    function GetChildNodes: TDOMNodeList;

    property NodeName: DOMString read GetNodeName;
    property NodeValue: DOMString read GetNodeValue write SetNodeValue;
    property NodeType: Integer read GetNodeType;
    property ParentNode: TDOMNode read GetParentNode;
    property FirstChild: TDOMNode read GetFirstChild;
    property LastChild: TDOMNode read GetLastChild;
    property ChildNodes: TDOMNodeList read GetChildNodes;
    property PreviousSibling: TDOMNode read GetPreviousSibling;
    property NextSibling: TDOMNode read FNextSibling;
    property Attributes: TDOMNamedNodeMap read GetAttributes;
    property OwnerDocument: TDOMDocument read GetOwnerDocument;

    function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; virtual;
    function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; virtual;
    function DetachChild(OldChild: TDOMNode): TDOMNode; virtual;
    function RemoveChild(OldChild: TDOMNode): TDOMNode;
    function AppendChild(NewChild: TDOMNode): TDOMNode;
    function HasChildNodes: Boolean; virtual;
    function CloneNode(deep: Boolean): TDOMNode; overload; virtual;

    // DOM level 2
    function IsSupported(const Feature, Version: DOMString): Boolean;
    function HasAttributes: Boolean; virtual;
    procedure Normalize; virtual;

    property NamespaceURI: DOMString read GetNamespaceURI;
    property LocalName: DOMString read GetLocalName;
    property Prefix: DOMString read GetPrefix write SetPrefix;
    // DOM level 3
    property TextContent: DOMString read GetTextContent write SetTextContent;
    function LookupPrefix(const nsURI: DOMString): DOMString;
    function LookupNamespaceURI(const APrefix: DOMString): DOMString;
    function IsDefaultNamespace(const nsURI: DOMString): Boolean;
    property baseURI: DOMString read GetBaseURI;
    // Extensions to DOM interface:
    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; virtual;
    function FindNode(const ANodeName: DOMString): TDOMNode; virtual;
    function CompareName(const name: DOMString): Integer; virtual;
    procedure SetReadOnly(Value: Boolean);    
    property Flags: TNodeFlags read FFlags;
  end;

  TDOMNodeClass = class of TDOMNode;
  TDOMElementClass = class of TDOMElement;

  { The following class is an implementation specific extension, it is just an
    extended implementation of TDOMNode, the generic DOM::Node interface
    implementation. (Its main purpose is to save memory in a big node tree) }

  TDOMNode_WithChildren = class(TDOMNode)
  protected
    FFirstChild: TDOMNode;
    FChildNodes: TDOMNodeList;
    function GetFirstChild: TDOMNode; override;
    function GetLastChild: TDOMNode; override;
    procedure CloneChildren(ACopy: TDOMNode; ACloneOwner: TDOMDocument);
    procedure FreeChildren;
    function GetTextContent: DOMString; override;
    procedure SetTextContent(const AValue: DOMString); override;
  public
    destructor Destroy; override;
    function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; override;
    function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; override;
    function DetachChild(OldChild: TDOMNode): TDOMNode; override;
    function HasChildNodes: Boolean; override;
    function FindNode(const ANodeName: DOMString): TDOMNode; override;
    procedure InternalAppend(NewChild: TDOMNode);
  end;

  { A common ancestor for Document and Entity nodes. }

  TDOMNode_TopLevel = class(TDOMNode_WithChildren)
  protected
    FInputEncoding: DOMString;
    FXMLEncoding: DOMString;
    FURI: DOMString;
    FXMLVersion: TXMLVersion;
    function GetXMLVersion: DOMString;
  public
    property InputEncoding: DOMString read FInputEncoding;
    property XMLEncoding: DOMString read FXMLEncoding;
    // extension
    procedure SetHeaderData(aXmlVersion: TXMLVersion; const aXmlEncoding: DOMString);
  end;

// -------------------------------------------------------
//   NodeList
// -------------------------------------------------------

  TFilterResult = (frFalse, frNorecurseFalse, frTrue, frNorecurseTrue);

  TDOMNodeList = class(TObject)
  protected
    FNode: TDOMNode;
    FRevision: Integer;
    FList: TFPList;
    function GetCount: LongWord;
    function GetItem(index: LongWord): TDOMNode;
    function NodeFilter(aNode: TDOMNode): TFilterResult; virtual;
    // now deprecated in favor of NodeFilter
    procedure BuildList; virtual;
  public
    constructor Create(ANode: TDOMNode);
    destructor Destroy; override;
    property Item[index: LongWord]: TDOMNode read GetItem; default;
    property Count: LongWord read GetCount;
    property Length: LongWord read GetCount;
  end;

  { an extension to DOM interface, used to build recursive lists of elements }

  TDOMElementList = class(TDOMNodeList)
  protected
    filter: DOMString;
    FNSIndexFilter: Integer;
    localNameFilter: DOMString;
    FMatchNS: Boolean;
    FMatchAnyNS: Boolean;
    UseFilter: Boolean;
    function NodeFilter(aNode: TDOMNode): TFilterResult; override;
  public
    constructor Create(ANode: TDOMNode; const AFilter: DOMString); overload;
    constructor Create(ANode: TDOMNode; const nsURI, localName: DOMString); overload;
  end;


// -------------------------------------------------------
//   NamedNodeMap
// -------------------------------------------------------

  TDOMNamedNodeMap = class(TObject)
  protected
    FOwner: TDOMNode;
    FList: TFPList;
    function GetItem(index: LongWord): TDOMNode;
    function GetLength: LongWord;
    function Find(const name: DOMString; out Index: LongWord): Boolean;
    function Delete(index: LongWord): TDOMNode; virtual;
    function InternalRemove(const name: DOMString): TDOMNode;
    function ValidateInsert(arg: TDOMNode): Integer; virtual;
  public
    constructor Create(AOwner: TDOMNode);
    destructor Destroy; override;

    function GetNamedItem(const name: DOMString): TDOMNode;
    function SetNamedItem(arg: TDOMNode): TDOMNode; virtual;
    function RemoveNamedItem(const name: DOMString): TDOMNode;
    // Introduced in DOM Level 2:
    function getNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode; virtual;
    function setNamedItemNS(arg: TDOMNode): TDOMNode; virtual;
    function removeNamedItemNS(const namespaceURI,localName: DOMString): TDOMNode; virtual;

    property Item[index: LongWord]: TDOMNode read GetItem; default;
    property Length: LongWord read GetLength;
  end;


// -------------------------------------------------------
//   CharacterData
// -------------------------------------------------------

  TDOMCharacterData = class(TDOMNode)
  private
    FNodeValue: DOMString;
  protected
    function  GetLength: LongWord;
    function GetNodeValue: DOMString; override;
    procedure SetNodeValue(const AValue: DOMString); override;
  public
    property Data: DOMString read FNodeValue write SetNodeValue;
    property Length: LongWord read GetLength;
    function SubstringData(offset, count: LongWord): DOMString;
    procedure AppendData(const arg: DOMString);
    procedure InsertData(offset: LongWord; const arg: DOMString);
    procedure DeleteData(offset, count: LongWord);
    procedure ReplaceData(offset, count: LongWord; const arg: DOMString);
  end;


// -------------------------------------------------------
//   DOMImplementation
// -------------------------------------------------------

  TDOMImplementation = class
  public
    function HasFeature(const feature, version: DOMString): Boolean;

    // Introduced in DOM Level 2:

    function CreateDocumentType(const QualifiedName, PublicID,
      SystemID: DOMString): TDOMDocumentType;
    function CreateDocument(const NamespaceURI, QualifiedName: DOMString;
      doctype: TDOMDocumentType): TDOMDocument;
  end;


// -------------------------------------------------------
//   DocumentFragment
// -------------------------------------------------------

  TDOMDocumentFragment = class(TDOMNode_WithChildren)
  protected
    function GetNodeType: Integer; override;
    function GetNodeName: DOMString; override;
  public
    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
  end;


// -------------------------------------------------------
//   Document
// -------------------------------------------------------
  // TODO: to be replaced by more suitable container
  TNamespaces = array of DOMString;

  TDOMDocument = class(TDOMNode_TopLevel)
  protected
    FIDList: THashTable;
    FRevision: Integer;
    FImplementation: TDOMImplementation;
    FNamespaces: TNamespaces;
    FNames: THashTable;
    FEmptyNode: TDOMElement;
    FNodeLists: THashTable;
    FMaxPoolSize: Integer;
    FPools: PNodePoolArray;
    FXmlStandalone: Boolean;
    FStdUri_xml: PHashItem;
    FStdUri_xmlns: PHashItem;
    function GetDocumentElement: TDOMElement;
    function GetDocType: TDOMDocumentType;
    function GetNodeType: Integer; override;
    function GetNodeName: DOMString; override;
    function GetTextContent: DOMString; override;
    function GetOwnerDocument: TDOMDocument; override;
    procedure SetTextContent(const value: DOMString); override;
    procedure RemoveID(Elem: TDOMElement);
    function GetChildNodeList(aNode: TDOMNode): TDOMNodeList;
    function GetElementList(aNode: TDOMNode; const nsURI, aLocalName: DOMString; UseNS: Boolean): TDOMNodeList;
    procedure NodeListDestroyed(aList: TDOMNodeList);
    function Alloc(AClass: TDOMNodeClass): TDOMNode;
    procedure SetXMLVersion(const aValue: DOMString); virtual;
    procedure SetXMLStandalone(aValue: Boolean); virtual;
    function ValidateQName(const nsUri, qName: DOMString; out nsidx: PHashItem): Integer;
  public
    function IndexOfNS(const nsURI: DOMString; AddIfAbsent: Boolean = False): Integer;
    function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; override;
    function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; override;
    property DocType: TDOMDocumentType read GetDocType;
    property Impl: TDOMImplementation read FImplementation;
    property DocumentElement: TDOMElement read GetDocumentElement;

    function CreateElement(const tagName: DOMString): TDOMElement; virtual;
    function CreateElementBuf(Buf: DOMPChar; Length: Integer): TDOMElement;
    function CreateDocumentFragment: TDOMDocumentFragment;
    function CreateTextNode(const data: DOMString): TDOMText;
    function CreateTextNodeBuf(Buf: DOMPChar; Length: Integer; IgnWS: Boolean): TDOMText;
    function CreateComment(const data: DOMString): TDOMComment;
    function CreateCommentBuf(Buf: DOMPChar; Length: Integer): TDOMComment;
    function CreateCDATASection(const data: DOMString): TDOMCDATASection;
      virtual;
    function CreateProcessingInstruction(const target, data: DOMString):
      TDOMProcessingInstruction; virtual;
    function CreateAttribute(const name: DOMString): TDOMAttr;
    function CreateAttributeBuf(Buf: DOMPChar; Length: Integer): TDOMAttr;
    function CreateEntityReference(const name: DOMString): TDOMEntityReference;
      virtual;
    function GetElementsByTagName(const tagname: DOMString): TDOMNodeList;

    // DOM level 2 methods
    function ImportNode(ImportedNode: TDOMNode; Deep: Boolean): TDOMNode;
    function CreateElementNS(const nsURI, QualifiedName: DOMString): TDOMElement; overload;
    function CreateElementNS(const nsURI, QualifiedName: DOMString;
      AClass: TDOMElementClass): TDOMElement; overload;
    function CreateAttributeNS(const nsURI, QualifiedName: DOMString): TDOMAttr;
    function GetElementsByTagNameNS(const nsURI, alocalName: DOMString): TDOMNodeList;
    function GetElementById(const ElementID: DOMString): TDOMElement;
    // DOM level 3:
    property documentURI: DOMString read FURI write FURI;
    property XMLVersion: DOMString read GetXMLVersion write SetXMLVersion;
    property XMLStandalone: Boolean read FXmlStandalone write SetXmlStandalone;
    // Extensions to DOM interface:
    constructor Create; virtual;
    destructor Destroy; override;
    function CloneNode(deep: Boolean): TDOMNode; overload; override;
    property Names: THashTable read FNames;
    property IDs: THashTable read FIDList write FIDList;
  end;

  TXMLDocument = class(TDOMDocument)
  protected
    procedure SetXMLVersion(const aValue: DOMString); override;
    procedure SetXMLStandalone(aValue: Boolean); override;
  public
    // These fields are extensions to the DOM interface:
    StylesheetType, StylesheetHRef: DOMString;

    constructor Create; override;
    function CreateCDATASection(const data: DOMString): TDOMCDATASection; override;
    function CreateProcessingInstruction(const target, data: DOMString):
      TDOMProcessingInstruction; override;
    function CreateEntityReference(const name: DOMString): TDOMEntityReference; override;
  end;

  // This limits number of namespaces per document to 65535,
  // and prefix length to 65535, too.
  // I believe that higher values may only be found in deliberately malformed documents.
  TNamespaceInfo = packed record
    NSIndex: Word;
    PrefixLen: Word;
    QName: PHashItem;
  end;

// -------------------------------------------------------
//   Attr
// -------------------------------------------------------

  TAttrDataType = xmlutils.TAttrDataType;

  TDOMNode_NS = class(TDOMNode_WithChildren)
  protected
    FNSI: TNamespaceInfo;
    function GetNodeName: DOMString; override;
    function GetLocalName: DOMString; override;
    function GetNamespaceURI: DOMString; override;
    function GetPrefix: DOMString; override;
    procedure SetPrefix(const Value: DOMString); override;
  public
    { Used by parser }
    procedure SetNSI(const nsUri: DOMString; ColonPos: Integer);
    function CompareName(const AName: DOMString): Integer; override;
    property NSI: TNamespaceInfo read FNSI;
  end;

  TDOMAttr = class(TDOMNode_NS)
  protected
    FDataType: TAttrDataType;
    function  GetNodeValue: DOMString; override;
    function GetNodeType: Integer; override;
    function GetParentNode: TDOMNode; override;
    function GetSpecified: Boolean;
    function GetIsID: Boolean;
    function GetOwnerElement: TDOMElement;
    procedure SetNodeValue(const AValue: DOMString); override;
  public
    destructor Destroy; override;
    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
    property Name: DOMString read GetNodeName;
    property Specified: Boolean read GetSpecified;
    property Value: DOMString read GetNodeValue write SetNodeValue;
    property OwnerElement: TDOMElement read GetOwnerElement;
    property IsID: Boolean read GetIsID;
    // extensions
    // TODO: this is to be replaced with DOM 3 TypeInfo
    property DataType: TAttrDataType read FDataType write FDataType;
  end;


// -------------------------------------------------------
//   Element
// -------------------------------------------------------

  TDOMElement = class(TDOMNode_NS)
  protected
    FAttributes: TDOMNamedNodeMap;
    function GetNodeType: Integer; override;
    function GetAttributes: TDOMNamedNodeMap; override;
    procedure AttachDefaultAttrs;
    function InternalLookupPrefix(const nsURI: DOMString; Original: TDOMElement): DOMString;
    procedure RestoreDefaultAttr(AttrDef: TAttributeDef);
  public
    destructor Destroy; override;
    function  CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
    procedure Normalize; override;
    property  TagName: DOMString read GetNodeName;
    function  GetAttribute(const name: DOMString): DOMString;
    procedure SetAttribute(const name, value: DOMString);
    procedure RemoveAttribute(const name: DOMString);
    function  GetAttributeNode(const name: DOMString): TDOMAttr;
    function SetAttributeNode(NewAttr: TDOMAttr): TDOMAttr;
    function RemoveAttributeNode(OldAttr: TDOMAttr): TDOMAttr;
    function  GetElementsByTagName(const name: DOMString): TDOMNodeList;

    // Introduced in DOM Level 2:
    function GetAttributeNS(const nsURI, aLocalName: DOMString): DOMString;
    procedure SetAttributeNS(const nsURI, qualifiedName, value: DOMString);
    procedure RemoveAttributeNS(const nsURI, aLocalName: DOMString);
    function GetAttributeNodeNS(const nsURI, aLocalName: DOMString): TDOMAttr;
    function SetAttributeNodeNS(newAttr: TDOMAttr): TDOMAttr;
    function GetElementsByTagNameNS(const nsURI, aLocalName: DOMString): TDOMNodeList;
    function hasAttribute(const name: DOMString): Boolean;
    function hasAttributeNS(const nsURI, aLocalName: DOMString): Boolean;
    function HasAttributes: Boolean; override;
    // extension
    property AttribStrings[const Name: DOMString]: DOMString
      read GetAttribute write SetAttribute; default;
  end;


// -------------------------------------------------------
//   Text
// -------------------------------------------------------

  TDOMText = class(TDOMCharacterData)
  protected
    function GetNodeType: Integer; override;
    function GetNodeName: DOMString; override;
    procedure SetNodeValue(const aValue: DOMString); override;
  public
    function  CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
    function SplitText(offset: LongWord): TDOMText;
    function IsElementContentWhitespace: Boolean;
  end;


// -------------------------------------------------------
//   Comment
// -------------------------------------------------------

  TDOMComment = class(TDOMCharacterData)
  protected
    function GetNodeType: Integer; override;
    function GetNodeName: DOMString; override;
  public
    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
  end;


// -------------------------------------------------------
//   CDATASection
// -------------------------------------------------------

  TDOMCDATASection = class(TDOMText)
  protected
    function GetNodeType: Integer; override;
    function GetNodeName: DOMString; override;
  public
    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
  end;


// -------------------------------------------------------
//   DocumentType
// -------------------------------------------------------

  TDOMDocumentType = class(TDOMNode)
  protected
    FModel: TDTDModel;
    FEntities, FNotations: TDOMNamedNodeMap;
    function GetEntities: TDOMNamedNodeMap;
    function GetNotations: TDOMNamedNodeMap;
    function GetNodeType: Integer; override;
    function GetNodeName: DOMString; override;
    function GetPublicID: DOMString;
    function GetSystemID: DOMString;
    function GetInternalSubset: DOMString;
  public
    constructor Create(aOwner: TDOMDocument; aModel: TDTDModel);
    destructor Destroy; override;
    property Name: DOMString read GetNodeName;
    property Entities: TDOMNamedNodeMap read GetEntities;
    property Notations: TDOMNamedNodeMap read GetNotations;
  // Introduced in DOM Level 2:
    property PublicID: DOMString read GetPublicID;
    property SystemID: DOMString read GetSystemID;
    property InternalSubset: DOMString read GetInternalSubset;
  // extension
    property Model: TDTDModel read FModel;
  end;


// -------------------------------------------------------
//   Notation
// -------------------------------------------------------

  TDOMNotation = class(TDOMNode)
  protected
    FDecl: TNotationDecl;
    FBaseURI: DOMString;
    function GetNodeType: Integer; override;
    function GetNodeName: DOMString; override;
    function GetPublicID: DOMString;
    function GetSystemID: DOMString;
  public
    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
    property PublicID: DOMString read GetPublicID;
    property SystemID: DOMString read GetSystemID;
  end;


// -------------------------------------------------------
//   Entity
// -------------------------------------------------------

  TDOMEntity = class(TDOMNode_TopLevel)
  protected
    FDecl: TEntityDecl;
    FBaseURI: DOMString;
    function GetNodeType: Integer; override;
    function GetNodeName: DOMString; override;
    function GetPublicID: DOMString;
    function GetSystemID: DOMString;
    function GetNotationName: DOMString;
  public
    function CloneNode(deep: Boolean; aCloneOwner: TDOMDocument): TDOMNode; override;
    property PublicID: DOMString read GetPublicID;
    property SystemID: DOMString read GetSystemID;
    property NotationName: DOMString read GetNotationName;
    property XMLVersion: DOMString read GetXMLVersion;
  end;


// -------------------------------------------------------
//   EntityReference
// -------------------------------------------------------

  TDOMEntityReference = class(TDOMNode_WithChildren)
  protected
    FName: DOMString;
    function GetNodeType: Integer; override;
    function GetNodeName: DOMString; override;
  public
    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
  end;


// -------------------------------------------------------
//   ProcessingInstruction
// -------------------------------------------------------

  TDOMProcessingInstruction = class(TDOMNode)
  private
    FTarget: DOMString;
    FNodeValue: DOMString;
  protected
    function GetNodeType: Integer; override;
    function GetNodeName: DOMString; override;
    function GetNodeValue: DOMString; override;
    procedure SetNodeValue(const AValue: DOMString); override;
  public
    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
    property Target: DOMString read FTarget;
    property Data: DOMString read FNodeValue write SetNodeValue;
  end;

// TNodePool - custom memory management for TDOMNode's
// One pool manages objects of the same InstanceSize (may be of various classes)

  PExtent = ^TExtent;
  TExtent = record
    Next: PExtent;
    // following: array of TDOMNode instances
  end;

  TNodePool = class(TObject)
  private
    FCurrExtent: PExtent;
    FCurrExtentSize: Integer;
    FElementSize: Integer;
    FCurrBlock: TDOMNode;
    FFirstFree: TDOMNode;
    procedure AddExtent(AElemCount: Integer);
  public
    constructor Create(AElementSize: Integer; AElementCount: Integer = 32);
    destructor Destroy; override;
    function AllocNode(AClass: TDOMNodeClass): TDOMNode;
    procedure FreeNode(ANode: TDOMNode);
  end;

// temporary until things are settled
function LoadElement(doc: TDOMDocument; src: PNodeData; attrCount: Integer): TDOMElement;

// =======================================================
// =======================================================

implementation

uses
  UriParser;

{ a namespace-enabled NamedNodeMap }
type
  TAttributeMap = class(TDOMNamedNodeMap)
  private
    function FindNS(nsIndex: Integer; const aLocalName: DOMString;
      out Index: LongWord): Boolean;
    function InternalRemoveNS(const nsURI, aLocalName: DOMString): TDOMNode;
    procedure RestoreDefault(aName: PHashItem);
  protected
    function Delete(index: LongWord): TDOMNode; override;
    function ValidateInsert(arg: TDOMNode): Integer; override;
  public
    function setNamedItem(arg: TDOMNode): TDOMNode; override;
    function getNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode; override;
    function setNamedItemNS(arg: TDOMNode): TDOMNode; override;
    function removeNamedItemNS(const namespaceURI,localName: DOMString): TDOMNode; override;
  end;

// -------------------------------------------------------
//   DOM Exception
// -------------------------------------------------------

constructor EDOMError.Create(ACode: Integer; const ASituation: String);
begin
  Code := ACode;
  inherited Create(Self.ClassName + ' in ' + ASituation);
end;

constructor EDOMIndexSize.Create(const ASituation: String);    // 1
begin
  inherited Create(INDEX_SIZE_ERR, ASituation);
end;

constructor EDOMHierarchyRequest.Create(const ASituation: String);    // 3
begin
  inherited Create(HIERARCHY_REQUEST_ERR, ASituation);
end;

constructor EDOMWrongDocument.Create(const ASituation: String);    // 4
begin
  inherited Create(WRONG_DOCUMENT_ERR, ASituation);
end;

constructor EDOMNotFound.Create(const ASituation: String);    // 8
begin
  inherited Create(NOT_FOUND_ERR, ASituation);
end;

constructor EDOMNotSupported.Create(const ASituation: String);    // 9
begin
  inherited Create(NOT_SUPPORTED_ERR, ASituation);
end;

constructor EDOMInUseAttribute.Create(const ASituation: String);    // 10
begin
  inherited Create(INUSE_ATTRIBUTE_ERR, ASituation);
end;

constructor EDOMInvalidState.Create(const ASituation: String);    // 11
begin
  inherited Create(INVALID_STATE_ERR, ASituation);
end;

constructor EDOMSyntax.Create(const ASituation: String);    // 12
begin
  inherited Create(SYNTAX_ERR, ASituation);
end;

constructor EDOMInvalidModification.Create(const ASituation: String);    // 13
begin
  inherited Create(INVALID_MODIFICATION_ERR, ASituation);
end;

constructor EDOMNamespace.Create(const ASituation: String);    // 14
begin
  inherited Create(NAMESPACE_ERR, ASituation);
end;

constructor EDOMInvalidAccess.Create(const ASituation: String);    // 15
begin
  inherited Create(INVALID_ACCESS_ERR, ASituation);
end;


// -------------------------------------------------------
//   Node
// -------------------------------------------------------

constructor TDOMNode.Create(AOwner: TDOMDocument);
begin
  FOwnerDocument := AOwner;
  inherited Create;
end;

destructor TDOMNode.Destroy;
begin
  if Assigned(FParentNode) then
    FParentNode.DetachChild(Self);
  inherited Destroy;
end;

procedure TDOMNode.FreeInstance;
begin
  if Assigned(FPool) then
  begin
    CleanupInstance;
    TNodePool(FPool).FreeNode(Self);
  end
  else
    inherited FreeInstance;
end;

function TDOMNode.GetNodeValue: DOMString;
begin
  Result := '';
end;

function TDOMNode.GetParentNode: TDOMNode;
begin
  Result := FParentNode;
end;

procedure TDOMNode.SetNodeValue(const AValue: DOMString);
begin
  // do nothing
end;

function TDOMNode.GetChildNodes: TDOMNodeList;
begin
  Result := FOwnerDocument.GetChildNodeList(Self);
end;

function TDOMNode.GetFirstChild: TDOMNode;
begin
  Result := nil;
end;

function TDOMNode.GetLastChild: TDOMNode;
begin
  Result := nil;
end;

function TDOMNode.GetPreviousSibling: TDOMNode;
begin
  if nfFirstChild in FFlags then
    Result := nil
  else
    Result := FPreviousSibling;
end;

function TDOMNode.GetAttributes: TDOMNamedNodeMap;
begin
  Result := nil;
end;

function TDOMNode.InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode;
begin
  Changing;  // merely to comply with core3/nodeinsertbefore14
  raise EDOMHierarchyRequest.Create('Node.InsertBefore');
  Result:=nil;
end;

function TDOMNode.ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode;
begin
  Changing;  // merely to comply with core3/nodereplacechild21
  raise EDOMHierarchyRequest.Create('Node.ReplaceChild');
  Result:=nil;
end;

function TDOMNode.DetachChild(OldChild: TDOMNode): TDOMNode;
begin
  // OldChild isn't in our child list
  raise EDOMNotFound.Create('Node.RemoveChild');
  Result:=nil;
end;

function TDOMNode.RemoveChild(OldChild: TDOMNode): TDOMNode;
begin
  Result := DetachChild(OldChild);
end;

function TDOMNode.AppendChild(NewChild: TDOMNode): TDOMNode;
begin
  Result := InsertBefore(NewChild, nil);
end;

function TDOMNode.HasChildNodes: Boolean;
begin
  Result := False;
end;

function TDOMNode.CloneNode(deep: Boolean): TDOMNode;
begin
  Result := CloneNode(deep, FOwnerDocument);
end;

function TDOMNode.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
begin
// !! CreateFmt() does not set Code property !!
  raise EDOMNotSupported.Create(Format('Cloning/importing of %s is not supported', [ClassName]));
  Result:=nil;
end;

function TDOMNode.FindNode(const ANodeName: DOMString): TDOMNode;
begin
  // FIX: we have no children, hence cannot find anything
  Result := nil;
end;

function TDOMNode.GetRevision: Integer;
begin
  Result := FOwnerDocument.FRevision;
end;

function TDOMNode.IsSupported(const Feature, Version: DOMString): Boolean;
begin
  Result := FOwnerDocument.Impl.HasFeature(Feature, Version);
end;

function TDOMNode.HasAttributes: Boolean;
begin
  Result := False;
end;

procedure TDOMNode.Normalize;
var
  Child, tmp: TDOMNode;
  Txt: TDOMText;
begin
  Child := FirstChild;
  Txt := nil;

  while Assigned(Child) do
  begin
    if Child.NodeType = TEXT_NODE then
    begin
      tmp := Child.NextSibling;
      if TDOMText(Child).Data <> '' then
      begin
        if Assigned(Txt) then
        begin
          Txt.AppendData(TDOMText(Child).Data);
          // TODO: maybe should be smarter
          Exclude(Txt.FFlags, nfIgnorableWS);
        end
        else
        begin
          Txt := TDOMText(Child);
          Child := Child.NextSibling;
          Continue;
        end;
      end;
      Child.Free;
      Child := tmp;
    end
    else
    begin
      Child.Normalize;  // should be recursive!
      Child := Child.NextSibling;
      Txt := nil;
    end;
  end;
end;

function TDOMNode.GetTextContent: DOMString;
begin
  Result := NodeValue;
end;

procedure TDOMNode.SetTextContent(const AValue: DOMString);
begin
  SetNodeValue(AValue);
end;

function TDOMNode.GetNamespaceURI: DOMString;
begin
  Result := '';
end;

function TDOMNode.GetLocalName: DOMString;
begin
  Result := '';
end;

function TDOMNode.GetPrefix: DOMString;
begin
  Result := '';
end;

procedure TDOMNode.SetPrefix(const Value: DOMString);
begin
  // do nothing, override for Elements and Attributes
end;

function TDOMNode.GetOwnerDocument: TDOMDocument;
begin
  Result := FOwnerDocument;
end;

procedure TDOMNode.SetReadOnly(Value: Boolean);
var
  child: TDOMNode;
  attrs: TDOMNamedNodeMap;
  I: Integer;
begin
  if Value then
    Include(FFlags, nfReadOnly)
  else
    Exclude(FFlags, nfReadOnly);
  child := FirstChild;
  while Assigned(child) do
  begin
    child.SetReadOnly(Value);
    child := child.NextSibling;
  end;
  if HasAttributes then
  begin
    attrs := Attributes;
    for I := 0 to attrs.Length-1 do
      attrs[I].SetReadOnly(Value);
  end;
end;

procedure TDOMNode.Changing;
begin
  if (nfReadOnly in FFlags) and not (nfDestroying in FOwnerDocument.FFlags) then
    raise EDOMError.Create(NO_MODIFICATION_ALLOWED_ERR, 'Node.CheckReadOnly');
end;

function CompareDOMStrings(const s1, s2: DOMPChar; l1, l2: integer): integer;
var i: integer;
begin
  Result:=l1-l2;
  i:=0;
  while (i<l1) and (Result=0) do begin
    Result:=ord(s1[i])-ord(s2[i]);
    inc(i);
  end;
end;

// generic version (slow)
function TDOMNode.CompareName(const name: DOMString): Integer;
var
  SelfName: DOMString;
begin
  SelfName := NodeName;
  Result := CompareDOMStrings(DOMPChar(name), DOMPChar(SelfName), Length(name), Length(SelfName));
end;

// This will return nil for Entity, Notation, DocType and DocFragment's
function GetAncestorElement(n: TDOMNode): TDOMElement;
var
  parent: TDOMNode;
begin
  case n.nodeType of
    DOCUMENT_NODE:
      result := TDOMDocument(n).documentElement;
    ATTRIBUTE_NODE:
      result := TDOMAttr(n).OwnerElement;
  else
    parent := n.ParentNode;
    while Assigned(parent) and (parent.NodeType <> ELEMENT_NODE) do
      parent := parent.ParentNode;
    Result := TDOMElement(parent);
  end;
end;

// TODO: specs prescribe to return default namespace if APrefix=null,
// but we aren't able to distinguish null from an empty string.
// This breaks level3/nodelookupnamespaceuri08 which passes an empty string.
function TDOMNode.LookupNamespaceURI(const APrefix: DOMString): DOMString;
var
  Attr: TDOMAttr;
  Map: TDOMNamedNodeMap;
  I: Integer;
begin
  Result := '';
  if Self = nil then
    Exit;
  if nodeType = ELEMENT_NODE then
  begin
    if (nfLevel2 in FFlags) and (TDOMElement(Self).Prefix = APrefix) then
    begin
      result := Self.NamespaceURI;
      Exit;
    end;
    if HasAttributes then
    begin
      Map := Attributes;
      for I := 0 to Map.Length-1 do
      begin
        Attr := TDOMAttr(Map[I]);
        // should ignore level 1 atts here
        if ((Attr.Prefix = 'xmlns') and (Attr.localName = APrefix)) or
           ((Attr.localName = 'xmlns') and (APrefix = '')) then
        begin
          result := Attr.NodeValue;
          Exit;
        end;
      end
    end;
  end;
  result := GetAncestorElement(Self).LookupNamespaceURI(APrefix);
end;

function TDOMNode.LookupPrefix(const nsURI: DOMString): DOMString;
begin
  Result := '';
  if (nsURI = '') or (Self = nil) then
    Exit;
  if nodeType = ELEMENT_NODE then
    result := TDOMElement(Self).InternalLookupPrefix(nsURI, TDOMElement(Self))
  else
    result := GetAncestorElement(Self).LookupPrefix(nsURI);
end;

function TDOMNode.IsDefaultNamespace(const nsURI: DOMString): Boolean;
var
  Attr: TDOMAttr;
  Map: TDOMNamedNodeMap;
  I: Integer;
begin
  Result := False;
  if Self = nil then
    Exit;
  if nodeType = ELEMENT_NODE then
  begin
    if TDOMElement(Self).FNSI.PrefixLen = 0 then
    begin
      result := (nsURI = namespaceURI);
      Exit;
    end
    else if HasAttributes then
    begin
      Map := Attributes;
      for I := 0 to Map.Length-1 do
      begin
        Attr := TDOMAttr(Map[I]);
        if Attr.LocalName = 'xmlns' then
        begin
          result := (Attr.Value = nsURI);
          Exit;
        end;
      end;
    end;
  end;
  result := GetAncestorElement(Self).IsDefaultNamespace(nsURI);
end;

function GetParentURI(n: TDOMNode): DOMString;
var
  entity, parent: TDOMNode;
begin
  parent := n.ParentNode;
  if Assigned(parent) then
  begin
    entity := nil;
    case parent.nodeType of
      ENTITY_NODE:
        entity := parent;
      ENTITY_REFERENCE_NODE:
        if Assigned(n.OwnerDocument.DocType) then
          entity := n.OwnerDocument.DocType.Entities.GetNamedItem(parent.NodeName);
    end;
    if entity = nil then
      result := parent.BaseURI
    else
    { TODO: this will need fix when resource resolving is implemented;
      it should return the URI of actually fetched entity. }
      ResolveRelativeURI(TDOMEntity(entity).FDecl.FURI, TDOMEntity(entity).SystemID, result);
  end
  else
    result := n.OwnerDocument.DocumentURI;
end;

function TDOMNode.GetBaseURI: DOMString;
var
  base: DOMString;
  dtype: TDOMDocumentType;
  ent: TDOMEntity;
begin
  case NodeType of
    ELEMENT_NODE:
      begin
        result := GetParentURI(Self);
        { 'xml' prefix is restricted to xml namespace, so this will work
          regardless of namespace processing enabled }
        base := TDOMElement(Self).GetAttribute('xml:base');
        if base <> '' then
        begin
          ResolveRelativeUri(result, base, result);
        end;
      end;
    DOCUMENT_NODE:
      result := TDOMDocument(Self).FURI;
    PROCESSING_INSTRUCTION_NODE:
      result := GetParentURI(Self);
    { BaseUri of entities and notations is the URI where they're defined;
      cloning should cause this property to get lost. }
    ENTITY_NODE:
      result := TDOMEntity(Self).FBaseURI;
    NOTATION_NODE:
      result := TDOMNotation(Self).FBaseURI;
    ENTITY_REFERENCE_NODE:
      begin
        result := '';
        dtype := OwnerDocument.DocType;
        if Assigned(dtype) then
        begin
          ent := TDOMEntity(dtype.Entities.GetNamedItem(NodeName));
          if Assigned(ent) then
            result := ent.FDecl.FURI;
        end;
      end
  else
    result := '';
  end;
end;

//------------------------------------------------------------------------------

type
  TNodeTypeEnum = ELEMENT_NODE..NOTATION_NODE;
  TNodeTypeSet = set of TNodeTypeEnum;

const
  stdChildren = [TEXT_NODE, ENTITY_REFERENCE_NODE, PROCESSING_INSTRUCTION_NODE,
                 COMMENT_NODE, CDATA_SECTION_NODE, ELEMENT_NODE];

  ValidChildren: array [TNodeTypeEnum] of TNodeTypeSet = (
   stdChildren, { element }
   [TEXT_NODE, ENTITY_REFERENCE_NODE], { attribute }
   [], { text }
   [], { cdata }
   stdChildren, { ent ref }
   stdChildren, { entity }
   [], { pi }
   [], { comment }
   [ELEMENT_NODE, DOCUMENT_TYPE_NODE, PROCESSING_INSTRUCTION_NODE, COMMENT_NODE], { document }
   [], { doctype }
   stdChildren, { fragment }
   []  { notation }
  );

function TDOMNode_WithChildren.GetFirstChild: TDOMNode;
begin
  Result := FFirstChild;
end;

function TDOMNode_WithChildren.GetLastChild: TDOMNode;
begin
  if FFirstChild = nil then
    Result := nil
  else
    Result := FFirstChild.FPreviousSibling;
end;

destructor TDOMNode_WithChildren.Destroy;
begin
  FreeChildren;
  FChildNodes.Free; // its destructor will zero the field
  inherited Destroy;
end;

function TDOMNode_WithChildren.InsertBefore(NewChild, RefChild: TDOMNode):
  TDOMNode;
var
  Tmp: TDOMNode;
  NewChildType: Integer;
begin
  Result := NewChild;
  NewChildType := NewChild.NodeType;

  Changing;
  if NewChild.FOwnerDocument <> FOwnerDocument then
  begin
    if (NewChildType <> DOCUMENT_TYPE_NODE) or
    (NewChild.FOwnerDocument <> nil) then
      raise EDOMWrongDocument.Create('NodeWC.InsertBefore');
  end;

  if Assigned(RefChild) and (RefChild.ParentNode <> Self) then
    raise EDOMNotFound.Create('NodeWC.InsertBefore');

  // TODO: skip checking Fragments as well? (Fragment itself cannot be in the tree)
  if not (NewChildType in [TEXT_NODE, CDATA_SECTION_NODE, COMMENT_NODE, PROCESSING_INSTRUCTION_NODE]) and (NewChild.FirstChild <> nil) then
  begin
    Tmp := Self;
    while Assigned(Tmp) do
    begin
      if Tmp = NewChild then
        raise EDOMHierarchyRequest.Create('NodeWC.InsertBefore (cycle in tree)');
      Tmp := Tmp.ParentNode;
    end;
  end;
  if NewChild = RefChild then    // inserting node before itself is a no-op
    Exit;

  Inc(FOwnerDocument.FRevision); // invalidate nodelists

  if NewChildType = DOCUMENT_FRAGMENT_NODE then
  begin
    Tmp := NewChild.FirstChild;
    if Assigned(Tmp) then
    begin
      while Assigned(Tmp) do
      begin
        if not (Tmp.NodeType in ValidChildren[NodeType]) then
          raise EDOMHierarchyRequest.Create('NodeWC.InsertBefore');
        Tmp := Tmp.NextSibling;
      end;

      while Assigned(TDOMDocumentFragment(NewChild).FFirstChild) do
        InsertBefore(TDOMDocumentFragment(NewChild).FFirstChild, RefChild);
    end;
    Exit;
  end;

  if not (NewChildType in ValidChildren[NodeType]) then
    raise EDOMHierarchyRequest.Create('NodeWC.InsertBefore');

  if Assigned(NewChild.FParentNode) then
    NewChild.FParentNode.DetachChild(NewChild);

  NewChild.FNextSibling := RefChild;
  if RefChild = nil then  // append to the end
  begin
    if Assigned(FFirstChild) then
    begin
      Tmp := FFirstChild.FPreviousSibling;      { our last child }
      Tmp.FNextSibling := NewChild;
      NewChild.FPreviousSibling := Tmp;
    end
    else
    begin
      FFirstChild := NewChild;
      Include(NewChild.FFlags, nfFirstChild);
    end;
    FFirstChild.FPreviousSibling := NewChild;   { becomes our last child }
  end
  else   // insert before RefChild
  begin
    NewChild.FPreviousSibling := RefChild.FPreviousSibling;
    if RefChild = FFirstChild then
    begin
      Exclude(RefChild.FFlags, nfFirstChild);
      FFirstChild := NewChild;
      Include(NewChild.FFlags, nfFirstChild);
    end
    else
      RefChild.FPreviousSibling.FNextSibling := NewChild;
    RefChild.FPreviousSibling := NewChild;
  end;
  NewChild.FParentNode := Self;
end;

function TDOMNode_WithChildren.ReplaceChild(NewChild, OldChild: TDOMNode):
  TDOMNode;
begin
  InsertBefore(NewChild, OldChild);
  if Assigned(OldChild) and (OldChild <> NewChild) then
    RemoveChild(OldChild);
  Result := OldChild;
end;

function TDOMNode_WithChildren.DetachChild(OldChild: TDOMNode): TDOMNode;
var
  prev, next: TDOMNode;
begin
  Changing;

  if OldChild.ParentNode <> Self then
    raise EDOMNotFound.Create('NodeWC.RemoveChild');

  Inc(FOwnerDocument.FRevision); // invalidate nodelists

  if OldChild = FFirstChild then
  begin
    Exclude(OldChild.FFlags, nfFirstChild);
    FFirstChild := FFirstChild.FNextSibling;
    if Assigned(FFirstChild) then
    begin
      { maintain lastChild }
      Include(FFirstChild.FFlags, nfFirstChild);
      FFirstChild.FPreviousSibling := OldChild.FPreviousSibling;
    end;
  end
  else
  begin
    prev := OldChild.FPreviousSibling;
    next := OldChild.FNextSibling;
    prev.FNextSibling := next;
    if Assigned(next) then     { removing node in the middle }
      next.FPreviousSibling := prev
    else                       { removing the last child }
      FFirstChild.FPreviousSibling := prev;
  end;
  // Make sure removed child does not contain references to nowhere
  OldChild.FPreviousSibling := nil;
  OldChild.FNextSibling := nil;
  OldChild.FParentNode := nil;
  Result := OldChild;
end;

procedure TDOMNode_WithChildren.InternalAppend(NewChild: TDOMNode);
var
  Tmp: TDOMNode;
begin
  if Assigned(FFirstChild) then
  begin
    Tmp := FFirstChild.FPreviousSibling;      { our last child }
    Tmp.FNextSibling := NewChild;
    NewChild.FPreviousSibling := Tmp;
  end
  else
  begin
    FFirstChild := NewChild;
    Include(NewChild.FFlags, nfFirstChild);
  end;
  FFirstChild.FPreviousSibling := NewChild;   { becomes our last child }
  NewChild.FParentNode := Self;
end;

function TDOMNode_WithChildren.HasChildNodes: Boolean;
begin
  Result := Assigned(FFirstChild);
end;


function TDOMNode_WithChildren.FindNode(const ANodeName: DOMString): TDOMNode;
begin
  Result := FFirstChild;
  while Assigned(Result) do
  begin
    if Result.CompareName(ANodeName)=0 then
      Exit;
    Result := Result.NextSibling;
  end;
end;


procedure TDOMNode_WithChildren.CloneChildren(ACopy: TDOMNode;
  ACloneOwner: TDOMDocument);
var
  node: TDOMNode;
begin
  node := FirstChild;
  while Assigned(node) do
  begin
    TDOMNode_WithChildren(ACopy).InternalAppend(node.CloneNode(True, ACloneOwner));
    node := node.NextSibling;
  end;
end;

procedure TDOMNode_WithChildren.FreeChildren;
var
  child, next: TDOMNode;
begin
  child := FFirstChild;
  while Assigned(child) do
  begin
    next := child.NextSibling;
    child.FParentNode := nil;
    child.Destroy;   // we know it's not nil, so save a call
    child := next;
  end;
  FFirstChild := nil;
end;

function TDOMNode_WithChildren.GetTextContent: DOMString;
var
  child: TDOMNode;
begin
  Result := '';
  child := FFirstChild;
  // TODO: probably very slow, optimization needed
  while Assigned(child) do
  begin
    case child.NodeType of
      TEXT_NODE: if not (nfIgnorableWS in child.FFlags) then
        Result := Result + TDOMText(child).Data;
      COMMENT_NODE, PROCESSING_INSTRUCTION_NODE: ; // ignored
    else
      Result := Result + child.TextContent;
    end;
    child := child.NextSibling;
  end;
end;

procedure TDOMNode_WithChildren.SetTextContent(const AValue: DOMString);
begin
  Changing;
  while Assigned(FFirstChild) do
    DetachChild(FFirstChild);
  if AValue <> '' then
    AppendChild(FOwnerDocument.CreateTextNode(AValue));
end;

// -------------------------------------------------------
//   NodeList
// -------------------------------------------------------

constructor TDOMNodeList.Create(ANode: TDOMNode);
begin
  inherited Create;
  FNode := ANode;
  FRevision := ANode.GetRevision-1;   // force BuildList at first access
  FList := TFPList.Create;
end;

destructor TDOMNodeList.Destroy;
begin
  if (FNode is TDOMNode_WithChildren) and
    (TDOMNode_WithChildren(FNode).FChildNodes = Self) then
    TDOMNode_WithChildren(FNode).FChildNodes := nil
  else
    FNode.FOwnerDocument.NodeListDestroyed(Self);
  FList.Free;
  inherited Destroy;
end;

function TDOMNodeList.NodeFilter(aNode: TDOMNode): TFilterResult;
begin
// accept all nodes but don't allow recursion
  Result := frNorecurseTrue;
end;

procedure TDOMNodeList.BuildList;
var
  current, next: TDOMNode;
  res: TFilterResult;
begin
  FList.Clear;
  FRevision := FNode.GetRevision; // refresh

  current := FNode.FirstChild;

  while Assigned(current) do
  begin
    res := NodeFilter(current);
    if res in [frTrue, frNorecurseTrue] then
      FList.Add(current);

    next := nil;
    if res in [frTrue, frFalse] then
      next := current.FirstChild;

    if next = nil then
    begin
      while current <> FNode do
      begin
        next := current.NextSibling;
        if Assigned(next) then
          Break;
        current := current.ParentNode;
      end;
    end;
    current := next;
  end;
end;

function TDOMNodeList.GetCount: LongWord;
begin
  if FRevision <> FNode.GetRevision then
    BuildList;

  Result := FList.Count;
end;

function TDOMNodeList.GetItem(index: LongWord): TDOMNode;
begin
  if FRevision <> FNode.GetRevision then
    BuildList;

  if index < LongWord(FList.Count) then
    Result := TDOMNode(FList.List^[index])
  else
    Result := nil;
end;

{ TDOMElementList }

constructor TDOMElementList.Create(ANode: TDOMNode; const AFilter: DOMString);
begin
  inherited Create(ANode);
  filter := AFilter;
  UseFilter := filter <> '*';
end;

constructor TDOMElementList.Create(ANode: TDOMNode; const nsURI, localName: DOMString);
begin
  inherited Create(ANode);
  localNameFilter := localName;
  FMatchNS := True;
  FMatchAnyNS := (nsURI = '*');
  if not FMatchAnyNS then
    FNSIndexFilter := ANode.FOwnerDocument.IndexOfNS(nsURI);
  UseFilter := (localName <> '*');
end;

function TDOMElementList.NodeFilter(aNode: TDOMNode): TFilterResult;
var
  I, L: Integer;
begin
  Result := frFalse;
  if aNode.NodeType = ELEMENT_NODE then with TDOMElement(aNode) do
  begin
    if FMatchNS then
    begin
      if (FMatchAnyNS or (FNSI.NSIndex = Word(FNSIndexFilter))) then
      begin
        I := FNSI.PrefixLen;
        L := system.Length(FNSI.QName^.Key);
        if (not UseFilter or ((L-I = system.Length(localNameFilter)) and
          CompareMem(@FNSI.QName^.Key[I+1], DOMPChar(localNameFilter), system.Length(localNameFilter)*sizeof(WideChar)))) then
          Result := frTrue;
      end;
    end
    else if (not UseFilter or (TagName = Filter)) then
      Result := frTrue;
  end;
end;


// -------------------------------------------------------
//   NamedNodeMap
// -------------------------------------------------------

constructor TDOMNamedNodeMap.Create(AOwner: TDOMNode);
begin
  inherited Create;
  FOwner := AOwner;
  FList := TFPList.Create;
end;

destructor TDOMNamedNodeMap.Destroy;
var
  I: Integer;
begin
  for I := FList.Count-1 downto 0 do
    TDOMNode(FList.List^[I]).Free;
  FList.Free;
  inherited Destroy;
end;

function TDOMNamedNodeMap.GetItem(index: LongWord): TDOMNode;
begin
  if index < LongWord(FList.Count) then
    Result := TDOMNode(FList.List^[index])
  else
    Result := nil;
end;

function TDOMNamedNodeMap.GetLength: LongWord;
begin
  Result := FList.Count;
end;

function TDOMNamedNodeMap.Find(const name: DOMString; out Index: LongWord): Boolean;
var
  L, H, I, C: Integer;
begin
  Result := False;
  L := 0;
  H := FList.Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := TDOMNode(FList.List^[I]).CompareName(name);
    if C > 0 then L := I + 1 else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := True;
        L := I;
      end;
    end;
  end;
  Index := L;
end;

function TDOMNamedNodeMap.GetNamedItem(const name: DOMString): TDOMNode;
var
  i: Cardinal;
begin
  if Find(name, i) then
    Result := TDOMNode(FList.List^[i])
  else
    Result := nil;
end;

// Note: this *may* raise NOT_SUPPORTED_ERR if the document is e.g. HTML.
// This isn't checked now.
function TDOMNamedNodeMap.GetNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode;
begin
  Result := nil;
end;

function TDOMNamedNodeMap.ValidateInsert(arg: TDOMNode): Integer;
begin
  Result := 0;
  if nfReadOnly in FOwner.FFlags then
    Result := NO_MODIFICATION_ALLOWED_ERR
  else if arg.FOwnerDocument <> FOwner.FOwnerDocument then
    Result := WRONG_DOCUMENT_ERR;
{ Note: Since Entity and Notation maps are always read-only, and the AttributeMap
  overrides this method and does its own check for correct arg.NodeType, there's
  no point in checking NodeType here. }
end;

function TDOMNamedNodeMap.SetNamedItem(arg: TDOMNode): TDOMNode;
var
  i: Cardinal;
  Exists: Boolean;
  res: Integer;
begin
  res := ValidateInsert(arg);
  if res <> 0 then
    raise EDOMError.Create(res, 'NamedNodeMap.SetNamedItem');

  Exists := Find(arg.NodeName, i);
  if Exists then
  begin
    Result := TDOMNode(FList.List^[i]);
    FList.List^[i] := arg;
    exit;
  end;
  FList.Insert(i, arg);
  Result := nil;
end;

function TDOMNamedNodeMap.SetNamedItemNS(arg: TDOMNode): TDOMNode;
begin
{ Since the map contains only namespaceless nodes (all having empty
  localName and namespaceURI properties), a namespaced arg won't match
  any of them. Therefore, add it using nodeName as key.
  Note: a namespaceless arg is another story, as it will match *any* node
  in the map. This can be considered as a flaw in specs. }
  Result := SetNamedItem(arg);
end;

function TDOMNamedNodeMap.Delete(index: LongWord): TDOMNode;
begin
  Result := TDOMNode(FList.List^[index]);
  FList.Delete(index);
end;

function TDOMNamedNodeMap.InternalRemove(const name: DOMString): TDOMNode;
var
  i: Cardinal;
begin
  if Find(name, i) then
    Result := Delete(I)
  else
    Result := nil;
end;

function TDOMNamedNodeMap.RemoveNamedItem(const name: DOMString): TDOMNode;
begin
  if nfReadOnly in FOwner.FFlags then
    raise EDOMError.Create(NO_MODIFICATION_ALLOWED_ERR, 'NamedNodeMap.RemoveNamedItem');
  Result := InternalRemove(name);
  if Result = nil then
    raise EDOMNotFound.Create('NamedNodeMap.RemoveNamedItem');
end;

function TDOMNamedNodeMap.RemoveNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode;
begin
// see comments to SetNamedItemNS. Related tests are written clever enough
// in the sense they don't expect NO_MODIFICATION_ERR in first place.
  raise EDOMNotFound.Create('NamedNodeMap.RemoveNamedItemNS');
  Result := nil;
end;

{ TAttributeMap }

function TAttributeMap.Delete(index: LongWord): TDOMNode;
begin
  Result := inherited Delete(index);
  if Assigned(Result) then
  begin
    Result.FParentNode := nil;
    if Assigned(TDOMAttr(Result).FNSI.QName) then
      RestoreDefault(TDOMAttr(Result).FNSI.QName);
  end;
end;

function TAttributeMap.ValidateInsert(arg: TDOMNode): Integer;
begin
  Result := inherited ValidateInsert(arg);
  if Result = 0 then
  begin
    if arg.NodeType <> ATTRIBUTE_NODE then
      Result := HIERARCHY_REQUEST_ERR
    else if Assigned(arg.FParentNode) and (arg.FParentNode <> FOwner) then
      Result := INUSE_ATTRIBUTE_ERR;
  end;
end;

procedure TAttributeMap.RestoreDefault(aName: PHashItem);
var
  eldef: TElementDecl;
  attrdef: TAttributeDef;
begin
  if not Assigned(TDOMElement(FOwner).FNSI.QName) then  // safeguard
    Exit;
  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.GetAttrDef(aName);
    if Assigned(attrdef) and (attrdef.Default in [adDefault, adFixed]) then
      TDOMElement(FOwner).RestoreDefaultAttr(attrdef);
  end;
end;

// Since list is kept sorted by nodeName, we must use linear search here.
// This routine is not called while parsing, so parsing speed is not lowered.
function TAttributeMap.FindNS(nsIndex: Integer; const aLocalName: DOMString;
  out Index: LongWord): Boolean;
var
  I: Integer;
  P: DOMPChar;
begin
  for I := 0 to FList.Count-1 do
  begin
    with TDOMAttr(FList.List^[I]) do
    begin
      if nsIndex = FNSI.NSIndex then
      begin
        P := DOMPChar(FNSI.QName^.Key);
        if FNSI.PrefixLen > 1 then
          Inc(P, FNSI.PrefixLen);
        if CompareDOMStrings(DOMPChar(aLocalName), P, System.Length(aLocalName), System.Length(FNSI.QName^.Key) - FNSI.PrefixLen) = 0 then
        begin
          Index := I;
          Result := True;
          Exit;
        end;
      end;
    end;
  end;
  Result := False;
end;

function TAttributeMap.InternalRemoveNS(const nsURI, aLocalName: DOMString): TDOMNode;
var
  i: Cardinal;
  nsIndex: Integer;
begin
  Result := nil;
  nsIndex := FOwner.FOwnerDocument.IndexOfNS(nsURI);
  if (nsIndex >= 0) and FindNS(nsIndex, aLocalName, i) then
    Result := Delete(I);
end;

function TAttributeMap.getNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode;
var
  nsIndex: Integer;
  i: LongWord;
begin
  nsIndex := FOwner.FOwnerDocument.IndexOfNS(namespaceURI);
  if (nsIndex >= 0) and FindNS(nsIndex, localName, i) then
    Result := TDOMNode(FList.List^[i])
  else
    Result := nil;
end;

function TAttributeMap.setNamedItem(arg: TDOMNode): TDOMNode;
begin
  Result := inherited setNamedItem(arg);
  if Assigned(Result) then
    Result.FParentNode := nil;
  arg.FParentNode := FOwner;
end;

function TAttributeMap.setNamedItemNS(arg: TDOMNode): TDOMNode;
var
  i: LongWord;
  res: Integer;
  Exists: Boolean;
begin
  res := ValidateInsert(arg);
  if res <> 0 then
    raise EDOMError.Create(res, 'NamedNodeMap.SetNamedItemNS');

  Result := nil;
  with TDOMAttr(arg) do
  begin
    // calling LocalName is no good... but it is done once
    if FindNS(FNSI.NSIndex, localName, i) then
    begin
      Result := TDOMNode(FList.List^[i]);
      FList.Delete(i);
    end;
    // Do a non-namespace search in order to keep the list sorted on nodeName
    Exists := Find(FNSI.QName^.Key, i);
    if Exists and (Result = nil) then  // case when arg has no namespace
    begin
      Result := TDOMNode(FList.List^[i]);
      FList.List^[i] := arg;
    end
    else
      FList.Insert(i, arg);
  end;
  if Assigned(Result) then
    Result.FParentNode := nil;
  arg.FParentNode := FOwner;
end;

function TAttributeMap.removeNamedItemNS(const namespaceURI,
  localName: DOMString): TDOMNode;
begin
  if nfReadOnly in FOwner.FFlags then
    raise EDOMError.Create(NO_MODIFICATION_ALLOWED_ERR, 'NamedNodeMap.RemoveNamedItemNS');
  Result := InternalRemoveNS(namespaceURI, localName);
  if Result = nil then
     raise EDOMNotFound.Create('NamedNodeMap.RemoveNamedItemNS');
end;

// -------------------------------------------------------
//   CharacterData
// -------------------------------------------------------

function TDOMCharacterData.GetLength: LongWord;
begin
  Result := system.Length(FNodeValue);
end;

function TDOMCharacterData.GetNodeValue: DOMString;
begin
  Result := FNodeValue;
end;

procedure TDOMCharacterData.SetNodeValue(const AValue: DOMString);
begin
  Changing;
  FNodeValue := AValue;
end;

function TDOMCharacterData.SubstringData(offset, count: LongWord): DOMString;
begin
  if offset > Length then
    raise EDOMIndexSize.Create('CharacterData.SubstringData');
  Result := Copy(FNodeValue, offset + 1, count);
end;

procedure TDOMCharacterData.AppendData(const arg: DOMString);
begin
  Changing;
  FNodeValue := FNodeValue + arg;
end;

procedure TDOMCharacterData.InsertData(offset: LongWord; const arg: DOMString);
begin
  Changing;
  if offset > Length then
    raise EDOMIndexSize.Create('CharacterData.InsertData');
  Insert(arg, FNodeValue, offset+1);
end;

procedure TDOMCharacterData.DeleteData(offset, count: LongWord);
begin
  Changing;
  if offset > Length then
    raise EDOMIndexSize.Create('CharacterData.DeleteData');
  Delete(FNodeValue, offset+1, count);
end;

procedure TDOMCharacterData.ReplaceData(offset, count: LongWord; const arg: DOMString);
begin
  DeleteData(offset, count);
  InsertData(offset, arg);
end;


// -------------------------------------------------------
//   DocumentFragmet
// -------------------------------------------------------

function TDOMDocumentFragment.GetNodeType: Integer;
begin
  Result := DOCUMENT_FRAGMENT_NODE;
end;

function TDOMDocumentFragment.GetNodeName: DOMString;
begin
  Result := '#document-fragment';
end;

function TDOMDocumentFragment.CloneNode(deep: Boolean; aCloneOwner: TDOMDocument): TDOMNode;
begin
  Result := aCloneOwner.CreateDocumentFragment;
  if deep then
    CloneChildren(Result, aCloneOwner);
end;

// -------------------------------------------------------
//   Top-level node
// -------------------------------------------------------

function TDOMNode_TopLevel.GetXMLVersion: DOMString;
begin
  Result := xmlVersionStr[FXMLVersion];
end;

procedure TDOMNode_TopLevel.SetHeaderData(aXmlVersion: TXMLVersion; const aXmlEncoding: DOMString);
begin
  if aXmlVersion <> xmlVersionUnknown then
    FXMLVersion := aXmlVersion;
  FXMLEncoding := aXmlEncoding;
end;

// -------------------------------------------------------
//   DOMImplementation
// -------------------------------------------------------

{  Non-negative return value is Pos(':', QName), negative is DOM error code. }
function CheckQName(const QName: DOMString): Integer;
var
  I, L: Integer;
begin
  if not IsXmlName(QName) then
  begin
    Result := -INVALID_CHARACTER_ERR;
    Exit;
  end;

  L := Length(QName);
  Result := Pos(WideChar(':'), QName);
  if Result > 0 then
  begin
    for I := Result+1 to L-1 do  // check for second colon (Use IndexWord?)
      if QName[I] = ':' then
      begin
        Result := -NAMESPACE_ERR;
        Exit;
      end;
    // Name validity has already been checked by IsXmlName() call above.
    // So just check that colon isn't first or last char, and that it is follwed by NameStartChar.
    if ((Result = 1) or (Result = L) or not IsXmlName(@QName[Result+1], 1)) then
    begin
      Result := -NAMESPACE_ERR;
      Exit;
    end;
  end;
end;

function TDOMImplementation.HasFeature(const feature, version: DOMString):
  Boolean;
var
  s: string;
begin
  s := feature;   // force Ansi, features do not contain non-ASCII chars
  Result := (SameText(s, 'XML') and ((version = '') or (version = '1.0') or (version = '2.0'))) or
            (SameText(s, 'Core') and ((version = '') or (version = '2.0')));

end;

function TDOMImplementation.CreateDocumentType(const QualifiedName, PublicID,
  SystemID: DOMString): TDOMDocumentType;
var
  res: Integer;
  model: TDTDModel;
begin
  res := CheckQName(QualifiedName);
  if res < 0 then
    raise EDOMError.Create(-res, 'Implementation.CreateDocumentType');
  model := TDTDModel.Create(nil); // !!nowhere to get nametable from at this time
  model.FName := QualifiedName;
  // DOM does not restrict PublicID without SystemID (unlike XML spec)
  model.FPublicID := PublicID;
  model.FSystemID := SystemID;
  Result := TDOMDocumentType.Create(nil, model);
  model.Release;                  // now Result remains a sole owner of model
end;

function TDOMImplementation.CreateDocument(const NamespaceURI,
  QualifiedName: DOMString; doctype: TDOMDocumentType): TDOMDocument;
var
  Root: TDOMNode;
begin
  if Assigned(doctype) and Assigned(doctype.OwnerDocument) then
    raise EDOMWrongDocument.Create('Implementation.CreateDocument');
  Result := TXMLDocument.Create;
  Result.FImplementation := Self;
  try
    if Assigned(doctype) then
    begin
      Doctype.FOwnerDocument := Result;
      Result.AppendChild(doctype);
    end;
    Root := Result.CreateElementNS(NamespaceURI, QualifiedName);
    Result.AppendChild(Root);
  except
    Result.Free;
    raise;
  end;
end;


// -------------------------------------------------------
//   Document
// -------------------------------------------------------

constructor TDOMDocument.Create;
begin
  inherited Create(nil);
  FOwnerDocument := Self;
  FMaxPoolSize := (TDOMEntity.InstanceSize + sizeof(Pointer)-1) and not (sizeof(Pointer)-1) + sizeof(Pointer);
  FPools := AllocMem(FMaxPoolSize);
  FNames := THashTable.Create(256, True);
  SetLength(FNamespaces, 3);
  // Namespace #0 should always be an empty string
  FNamespaces[1] := stduri_xml;
  FNamespaces[2] := stduri_xmlns;
  FEmptyNode := TDOMElement.Create(Self);
  FStdUri_xml := FNames.FindOrAdd(stduri_xml);
  FStdUri_xmlns := FNames.FindOrAdd(stduri_xmlns);
end;

destructor TDOMDocument.Destroy;
var
  i: Integer;
begin
  Include(FFlags, nfDestroying);
  FreeAndNil(FIDList);   // set to nil before starting destroying children
  FNodeLists.Free;
  FEmptyNode.Free;
  inherited Destroy;
  for i := 0 to (FMaxPoolSize div sizeof(TNodePool))-1 do
    FPools^[i].Free;
  FreeMem(FPools);
  FNames.Free;           // free the nametable after inherited has destroyed the children
                         // (because children reference the nametable)
end;

function TDOMDocument.CloneNode(deep: Boolean): TDOMNode;
type
  TDOMDocumentClass = class of TDOMDocument;
var
  Clone: TDOMDocument;
  node, doctypenode: TDOMNode;
begin
  Clone := TDOMDocumentClass(ClassType).Create;
  Clone.FInputEncoding := FInputEncoding;
  Clone.FXMLEncoding := FXMLEncoding;
  Clone.FXMLVersion := FXMLVersion;
  Clone.FXMLStandalone := FXMLStandalone;
  Clone.FURI := FURI;
  if deep then
  begin
    node := FirstChild;
    doctypenode := DocType;
    while Assigned(node) do
    begin
      {TODO: now just skip doctype, a better solution is to be found.}
      if node <> doctypenode then
        Clone.InternalAppend(node.CloneNode(True, Clone));
      node := node.NextSibling;
    end;
  end;
  Result := Clone;
end;

function TDOMDocument.Alloc(AClass: TDOMNodeClass): TDOMNode;
var
  pp: TNodePool;
  size: Integer;
begin
  if nfDestroying in FFlags then
    raise EDOMError.Create(INVALID_ACCESS_ERR, 'Attempt to allocate node memory while destroying');
  size := (AClass.InstanceSize + sizeof(Pointer)-1) and not (sizeof(Pointer)-1);
  if size > FMaxPoolSize then
  begin
    Result := TDOMNode(AClass.NewInstance);
    Exit;
  end;

  pp := FPools^[size div sizeof(TNodePool)];
  if pp = nil then
  begin
    pp := TNodePool.Create(size);
    FPools^[size div sizeof(TNodePool)] := pp;
  end;
  Result := pp.AllocNode(AClass);
end;

// This shouldn't be called if document has no IDs,
// or when it is being destroyed
// TODO: This could be much faster if removing ID happens
// upon modification of corresponding attribute value.

procedure TDOMDocument.RemoveID(Elem: TDOMElement);
begin
  FIDList.RemoveData(Elem);
end;

function TDOMDocument.GetNodeType: Integer;
begin
  Result := DOCUMENT_NODE;
end;

function TDOMDocument.GetNodeName: DOMString;
begin
  Result := '#document';
end;

function TDOMDocument.GetTextContent: DOMString;
begin
  Result := '';
end;

procedure TDOMDocument.SetTextContent(const value: DOMString);
begin
  // Document ignores setting TextContent
end;

function TDOMDocument.GetOwnerDocument: TDOMDocument;
begin
  Result := nil;
end;

function TDOMDocument.InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode;
var
  nType: Integer;
begin
  nType := NewChild.NodeType;
  if ((nType = ELEMENT_NODE) and Assigned(DocumentElement)) or
     ((nType = DOCUMENT_TYPE_NODE) and Assigned(DocType)) then
       raise EDOMHierarchyRequest.Create('Document.InsertBefore');
  Result := inherited InsertBefore(NewChild, RefChild);
end;

function TDOMDocument.ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode;
var
  nType: Integer;
begin
  nType := NewChild.NodeType;
  if ((nType = ELEMENT_NODE) and (OldChild = DocumentElement)) or   // root can be replaced by another element
     ((nType = DOCUMENT_TYPE_NODE) and (OldChild = DocType)) then   // and so can be DTD
  begin
    inherited InsertBefore(NewChild, OldChild);
    Result := OldChild;
    if OldChild <> NewChild then
      RemoveChild(OldChild);
  end
  else
    Result := inherited ReplaceChild(NewChild, OldChild);
end;

function TDOMDocument.GetDocumentElement: TDOMElement;
var
  node: TDOMNode;
begin
  node := FFirstChild;
  while Assigned(node) and (node.NodeType <> ELEMENT_NODE) do
    node := node.NextSibling;
  Result := TDOMElement(node);
end;

function TDOMDocument.GetDocType: TDOMDocumentType;
var
  node: TDOMNode;
begin
  node := FFirstChild;
  while Assigned(node) and (node.NodeType <> DOCUMENT_TYPE_NODE) do
    node := node.NextSibling;
  Result := TDOMDocumentType(node);
end;

function TDOMDocument.CreateElement(const tagName: DOMString): TDOMElement;
begin
  if not IsXmlName(tagName) then
    raise EDOMError.Create(INVALID_CHARACTER_ERR, 'DOMDocument.CreateElement');
  TDOMNode(Result) := Alloc(TDOMElement);
  Result.Create(Self);
  Result.FNSI.QName := FNames.FindOrAdd(DOMPChar(tagName), Length(tagName));
  Result.AttachDefaultAttrs;
end;

function TDOMDocument.CreateElementBuf(Buf: DOMPChar; Length: Integer): TDOMElement;
begin
  TDOMNode(Result) := Alloc(TDOMElement);
  Result.Create(Self);
  Result.FNSI.QName := FNames.FindOrAdd(Buf, Length);
end;

function TDOMDocument.CreateDocumentFragment: TDOMDocumentFragment;
begin
  TDOMNode(Result) := Alloc(TDOMDocumentFragment);
  Result.Create(Self);
end;

function TDOMDocument.CreateTextNode(const data: DOMString): TDOMText;
begin
  TDOMNode(Result) := Alloc(TDOMText);
  Result.Create(Self);
  Result.FNodeValue := data;
end;

function TDOMDocument.CreateTextNodeBuf(Buf: DOMPChar; Length: Integer; IgnWS: Boolean): TDOMText;
begin
  TDOMNode(Result) := Alloc(TDOMText);
  Result.Create(Self);
  SetString(Result.FNodeValue, Buf, Length);
  if IgnWS then
    Include(Result.FFlags, nfIgnorableWS);
end;


function TDOMDocument.CreateComment(const data: DOMString): TDOMComment;
begin
  TDOMNode(Result) := Alloc(TDOMComment);
  Result.Create(Self);
  Result.FNodeValue := data;
end;

function TDOMDocument.CreateCommentBuf(Buf: DOMPChar; Length: Integer): TDOMComment;
begin
  TDOMNode(Result) := Alloc(TDOMComment);
  Result.Create(Self);
  SetString(Result.FNodeValue, Buf, Length);
end;

function TDOMDocument.CreateCDATASection(const data: DOMString):
  TDOMCDATASection;
begin
  raise EDOMNotSupported.Create('DOMDocument.CreateCDATASection');
  Result:=nil;
end;

function TDOMDocument.CreateProcessingInstruction(const target,
  data: DOMString): TDOMProcessingInstruction;
begin
  raise EDOMNotSupported.Create('DOMDocument.CreateProcessingInstruction');
  Result:=nil;
end;

function TDOMDocument.CreateAttribute(const name: DOMString): TDOMAttr;
begin
  if not IsXmlName(name) then
    raise EDOMError.Create(INVALID_CHARACTER_ERR, 'DOMDocument.CreateAttribute');
  TDOMNode(Result) := Alloc(TDOMAttr);
  Result.Create(Self);
  Result.FNSI.QName := FNames.FindOrAdd(DOMPChar(name), Length(name));
  Include(Result.FFlags, nfSpecified);
end;

function TDOMDocument.CreateAttributeBuf(Buf: DOMPChar; Length: Integer): TDOMAttr;
begin
  TDOMNode(Result) := Alloc(TDOMAttr);
  Result.Create(Self);
  Result.FNSI.QName := FNames.FindOrAdd(buf, Length);
  Include(Result.FFlags, nfSpecified);
end;

function TDOMDocument.CreateEntityReference(const name: DOMString):
  TDOMEntityReference;
begin
  raise EDOMNotSupported.Create('DOMDocument.CreateEntityReference');
  Result:=nil;
end;

function TDOMDocument.GetChildNodeList(aNode: TDOMNode): TDOMNodeList;
begin
  if not (aNode is TDOMNode_WithChildren) then
    aNode := FEmptyNode;
  Result := TDOMNode_WithChildren(aNode).FChildNodes;
  if Result = nil then
  begin
    Result := TDOMNodeList.Create(aNode);
    TDOMNode_WithChildren(aNode).FChildNodes := Result;
  end;
end;

function TDOMDocument.GetElementList(aNode: TDOMNode; const nsURI, aLocalName: DOMString;
  UseNS: Boolean): TDOMNodeList;
var
  L: Integer;
  Key, P: DOMPChar;
  Item: PHashItem;
begin
  if FNodeLists = nil then
    FNodeLists := THashTable.Create(32, True);
  L := (sizeof(Pointer) div sizeof(WideChar)) + Length(aLocalName);
  if UseNS then
    Inc(L, Length(nsURI)+1);
  GetMem(Key, L*sizeof(WideChar));
  try
    // compose the key for hashing
    P := Key;
    PPointer(P)^ := aNode;
    Inc(PPointer(P));
    Move(DOMPChar(aLocalName)^, P^, Length(aLocalName)*sizeof(WideChar));
    if UseNS then
    begin
      Inc(P, Length(aLocalName));
      P^ := #12; Inc(P);  // separator -- diff ('foo','bar') from 'foobar'
      Move(DOMPChar(nsURI)^, P^, Length(nsURI)*sizeof(WideChar));
    end;
    // try finding in the hashtable
    Item := FNodeLists.FindOrAdd(Key, L);
    Result := TDOMNodeList(Item^.Data);
    if Result = nil then
    begin
      if UseNS then
        Result := TDOMElementList.Create(aNode, nsURI, aLocalName)
      else
        Result := TDOMElementList.Create(aNode, aLocalName);
      Item^.Data := Result;
    end;
  finally
    FreeMem(Key);
  end;
end;

function TDOMDocument.GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
begin
  Result := GetElementList(Self, '', tagname, False);
end;

function TDOMDocument.GetElementsByTagNameNS(const nsURI, aLocalName: DOMString): TDOMNodeList;
begin
  Result := GetElementList(Self, nsURI, aLocalName, True);
end;

{ This is linear hence slow. However:
  - if user code frees each nodelist ASAP, there are only few items in the hashtable
  - if user code does not free nodelists, this is not called at all.
}
procedure TDOMDocument.NodeListDestroyed(aList: TDOMNodeList);
begin
  if (not (nfDestroying in FFlags)) and (FNodeLists <> nil) then
    FNodeLists.RemoveData(aList);
end;

function TDOMDocument.ValidateQName(const nsUri, qName: DOMString;
  out nsidx: PHashItem): Integer;
begin
  nsidx := FNames.FindOrAdd(DOMPChar(nsUri), Length(nsUri));
  Result := CheckQName(qName);
  if Result >= 0 then
  begin
    // QName contains prefix, but no namespace
    if ((nsUri = '') and (Result > 0)) or
    // Bad usage of 'http://www.w3.org/2000/xmlns/'
    ((((Length(QName) = 5) or (Result = 6)) and (Pos(DOMString('xmlns'), QName) = 1)) <> (nsIdx = FStdUri_xmlns)) or
    // Bad usage of 'http://www.w3.org/XML/1998/namespace'
    ((Result = 4) and (Pos(DOMString('xml'), QName) = 1) and (nsIdx <> FStdUri_xml)) then
      Result := -NAMESPACE_ERR;
  end;
end;

function TDOMDocument.CreateAttributeNS(const nsURI,
  QualifiedName: DOMString): TDOMAttr;
var
  PrefIdx: Integer;
  nsidx: PHashItem;
begin
  PrefIdx := ValidateQName(nsURI, QualifiedName, nsidx);
  if PrefIdx < 0 then
    raise EDOMError.Create(-PrefIdx, 'Document.CreateAttributeNS');
  TDOMNode(Result) := Alloc(TDOMAttr);
  Result.Create(Self);
  Result.FNSI.QName := FNames.FindOrAdd(DOMPChar(QualifiedName), Length(QualifiedName));
  Result.FNSI.NSIndex := Word(IndexOfNS(nsURI, True));
  Result.FNSI.PrefixLen := Word(PrefIdx);
  Include(Result.FFlags, nfLevel2);
  Include(Result.FFlags, nfSpecified);
end;

function TDOMDocument.CreateElementNS(const nsURI,
  QualifiedName: DOMString): TDOMElement;
begin
     result:=CreateElementNS(nsURI, QualifiedName, TDOMElement);
end;

function TDOMDocument.CreateElementNS(const nsURI, QualifiedName: DOMString;
  AClass: TDOMElementClass): TDOMElement; overload;
var
  PrefIdx: Integer;
  nsidx: PHashItem;
begin
  PrefIdx := ValidateQName(nsURI, QualifiedName, nsidx);
  if PrefIdx < 0 then
    raise EDOMError.Create(-PrefIdx, 'Document.CreateElementNS');
  TDOMNode(Result) := Alloc(AClass);
  Result.Create(Self);
  Result.FNSI.QName := FNames.FindOrAdd(DOMPChar(QualifiedName), Length(QualifiedName));
  Result.FNSI.NSIndex := Word(IndexOfNS(nsURI, True));
  Result.FNSI.PrefixLen := Word(PrefIdx);
  Include(Result.FFlags, nfLevel2);
  Result.AttachDefaultAttrs;
end;

function TDOMDocument.GetElementById(const ElementID: DOMString): TDOMElement;
begin
  Result := nil;
  if Assigned(FIDList) then
    Result := TDOMElement(FIDList.Get(DOMPChar(ElementID), Length(ElementID)));
end;

function TDOMDocument.ImportNode(ImportedNode: TDOMNode;
  Deep: Boolean): TDOMNode;
begin
  Result := ImportedNode.CloneNode(Deep, Self);
end;

function TDOMDocument.IndexOfNS(const nsURI: DOMString; AddIfAbsent: Boolean): Integer;
var
  I: Integer;
begin
  // TODO: elaborate implementation
  for I := 0 to Length(FNamespaces)-1 do
    if FNamespaces[I] = nsURI then
    begin
      Result := I;
      Exit;
    end;
  if AddIfAbsent then
  begin
    Result := Length(FNamespaces);
    SetLength(FNamespaces, Result+1);
    FNamespaces[Result] := nsURI;
  end
  else
    Result := -1;
end;

procedure TDOMDocument.SetXMLVersion(const aValue: DOMString);
begin
  raise EDOMNotSupported.Create('DOMDocument.SetXMLVersion');
end;

procedure TDOMDocument.SetXMLStandalone(aValue: Boolean);
begin
  raise EDOMNotSupported.Create('DOMDocument.SetXMLStandalone');
end;

constructor TXMLDocument.Create;
begin
  inherited Create;
  FXMLVersion := xmlVersion10;
end;

function TXMLDocument.CreateCDATASection(const data: DOMString):
  TDOMCDATASection;
begin
  TDOMNode(Result) := Alloc(TDOMCDATASection);
  Result.Create(Self);
  Result.FNodeValue := data;
end;

function TXMLDocument.CreateProcessingInstruction(const target,
  data: DOMString): TDOMProcessingInstruction;
begin
  if not IsXmlName(target) then
    raise EDOMError.Create(INVALID_CHARACTER_ERR, 'XMLDocument.CreateProcessingInstruction');
  TDOMNode(Result) := Alloc(TDOMProcessingInstruction);
  Result.Create(Self);
  Result.FTarget := target;
  Result.FNodeValue := data;
end;

function TXMLDocument.CreateEntityReference(const name: DOMString):
  TDOMEntityReference;
var
  dType: TDOMDocumentType;
  ent: TDOMEntity;
begin
  if not IsXmlName(name) then
    raise EDOMError.Create(INVALID_CHARACTER_ERR, 'XMLDocument.CreateEntityReference');
  TDOMNode(Result) := Alloc(TDOMEntityReference);
  Result.Create(Self);
  Result.FName := name;
  dType := DocType;
  if Assigned(dType) then
  begin
    TDOMNode(ent) := dType.Entities.GetNamedItem(name);
    if Assigned(ent) then
      ent.CloneChildren(Result, Self);
  end;
  Result.SetReadOnly(True);
end;

procedure TXMLDocument.SetXMLVersion(const aValue: DOMString);
begin
  if aValue = '1.0' then
    FXMLVersion := xmlVersion10
  else if aValue = '1.1' then
    FXMLVersion := xmlVersion11
  else
    raise EDOMNotSupported.Create('XMLDocument.SetXMLVersion');
end;

procedure TXMLDocument.SetXMLStandalone(aValue: Boolean);
begin
  FXmlStandalone := aValue;
end;

{ TDOMNode_NS }

function TDOMNode_NS.GetNodeName: DOMString;
begin
  // Because FNSI.QName is not set by the TDOMNode itself, but is set by
  // other classes/functions, it is necessary to check if FNSQ.QName is
  // assigned.
  if assigned(FNSI.QName) then
    Result := FNSI.QName^.Key
  else
    Result := '';
end;

function TDOMNode_NS.GetLocalName: DOMString;
begin
  if nfLevel2 in FFlags then
    Result := Copy(FNSI.QName^.Key, FNSI.PrefixLen+1, MaxInt)
  else
    Result := '';
end;

function TDOMNode_NS.GetNamespaceURI: DOMString;
begin
  Result := FOwnerDocument.FNamespaces[FNSI.NSIndex];
end;

function TDOMNode_NS.GetPrefix: DOMString;
begin
  if FNSI.PrefixLen < 2 then
    Result := ''
  else
    Result := Copy(FNSI.QName^.Key, 1, FNSI.PrefixLen-1);
end;

procedure TDOMNode_NS.SetPrefix(const Value: DOMString);
var
  NewName: DOMString;
begin
  Changing;
  if not IsXmlName(Value) then
    raise EDOMError.Create(INVALID_CHARACTER_ERR, 'Node.SetPrefix');

  if (Pos(WideChar(':'), Value) > 0) or ((FNSI.NSIndex = 0) and (Value <> '')) or
    ((Value = 'xml') and (FNSI.NSIndex <> 1)) or
    ((ClassType = TDOMAttr) and  // BAD!
    ((Value = 'xmlns') and (FNSI.NSIndex <> 2)) or (FNSI.QName^.Key = 'xmlns')) then
    raise EDOMNamespace.Create('Node.SetPrefix');

  // TODO: rehash properly
  NewName := Value + ':' + Copy(FNSI.QName^.Key, FNSI.PrefixLen+1, MaxInt);
  FNSI.QName := FOwnerDocument.FNames.FindOrAdd(DOMPChar(NewName), Length(NewName));
  FNSI.PrefixLen := Length(Value)+1;
end;

function TDOMNode_NS.CompareName(const AName: DOMString): Integer;
begin
  Result := CompareDOMStrings(DOMPChar(AName), DOMPChar(NodeName), Length(AName), Length(NodeName));
end;

procedure TDOMNode_NS.SetNSI(const nsUri: DOMString; ColonPos: Integer);
begin
  FNSI.NSIndex := FOwnerDocument.IndexOfNS(nsURI, True);
  FNSI.PrefixLen := ColonPos;
  Include(FFlags, nfLevel2);
end;

// -------------------------------------------------------
//   Attr
// -------------------------------------------------------

function TDOMAttr.GetNodeType: Integer;
begin
  Result := ATTRIBUTE_NODE;
end;

function TDOMAttr.GetParentNode: TDOMNode;
begin
  Result := nil;
end;

destructor TDOMAttr.Destroy;
begin
  if Assigned(FParentNode) and not (nfDestroying in FParentNode.FFlags) then
  // TODO: This may raise NOT_FOUND_ERR in case something's really wrong
    TDOMElement(FParentNode).RemoveAttributeNode(Self);
  FParentNode := nil;
  inherited Destroy;
end;

function TDOMAttr.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
begin
  // Cloned attribute is always specified and carries its children
  if nfLevel2 in FFlags then
    Result := ACloneOwner.CreateAttributeNS(namespaceURI, NodeName)
  else
    Result := ACloneOwner.CreateAttribute(NodeName);
  TDOMAttr(Result).FDataType := FDataType;
  CloneChildren(Result, ACloneOwner);
end;

function TDOMAttr.GetNodeValue: DOMString;
begin
  Result := GetTextContent;
  if FDataType <> dtCdata then
    NormalizeSpaces(Result);
end;

procedure TDOMAttr.SetNodeValue(const AValue: DOMString);
begin
  SetTextContent(AValue);
  Include(FFlags, nfSpecified);
end;

function TDOMAttr.GetSpecified: Boolean;
begin
  Result := nfSpecified in FFlags;
end;

function TDOMAttr.GetIsID: Boolean;
begin
  Result := FDataType = dtID;
end;

function TDOMAttr.GetOwnerElement: TDOMElement;
begin
  Result := TDOMElement(FParentNode);
end;

// -------------------------------------------------------
//   Element
// -------------------------------------------------------

function TDOMElement.GetNodeType: Integer;
begin
  Result := ELEMENT_NODE;
end;

destructor TDOMElement.Destroy;
begin
  Include(FFlags, nfDestroying);
  if Assigned(FOwnerDocument.FIDList) then
    FOwnerDocument.RemoveID(Self);
  FAttributes.Free;
  FAttributes := nil;
  inherited Destroy;
end;

function TDOMElement.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
var
  i: Integer;
  Attr, AttrClone: TDOMAttr;
begin
  if ACloneOwner <> FOwnerDocument then
  begin
    // Importing has to go the hard way...
    if nfLevel2 in FFlags then
      Result := ACloneOwner.CreateElementNS(NamespaceURI, NodeName)
    else
      Result := ACloneOwner.CreateElement(NodeName);
    if Assigned(FAttributes) then
    begin
      for i := 0 to FAttributes.Length - 1 do
      begin
        Attr := TDOMAttr(FAttributes[i]);
        // destroy defaulted attributes (if any), it is safe because caller had not seen them yet
        if Attr.Specified then
          TDOMElement(Result).SetAttributeNode(TDOMAttr(Attr.CloneNode(True, ACloneOwner))).Free;
      end;
    end;
  end
  else   // Cloning may cheat a little bit.
  begin
    Result := FOwnerDocument.Alloc(TDOMElement);
    TDOMElement(Result).Create(FOwnerDocument);
    TDOMElement(Result).FNSI := FNSI;
    if nfLevel2 in FFlags then
      Include(Result.FFlags, nfLevel2);
    if Assigned(FAttributes) then
    begin
      // clone all attributes, but preserve nfSpecified flag
      for i := 0 to FAttributes.Length - 1 do
      begin
        Attr := TDOMAttr(FAttributes[i]);
        AttrClone := TDOMAttr(Attr.CloneNode(True, ACloneOwner));
        if not Attr.Specified then
          Exclude(AttrClone.FFlags, nfSpecified);
        TDOMElement(Result).SetAttributeNode(AttrClone);
      end;
    end;
  end;
  if deep then
    CloneChildren(Result, ACloneOwner);
end;

procedure TDOMElement.AttachDefaultAttrs;
var
  eldef: TElementDecl;
  attrdef: TAttributeDef;
  I: Integer;
begin
  if not Assigned(FNSI.QName) then     // safeguard
    Exit;
  eldef := TElementDecl(FNSI.QName^.Data);
  if Assigned(eldef) and eldef.NeedsDefaultPass then
  begin
    for I := 0 to eldef.AttrDefCount-1 do
    begin
      attrdef := eldef.AttrDefs[I];
      if attrdef.Default in [adDefault, adFixed] then
        RestoreDefaultAttr(attrdef);
    end;
  end;
end;

function TDOMElement.InternalLookupPrefix(const nsURI: DOMString; Original: TDOMElement): DOMString;
var
  I: Integer;
  Attr: TDOMAttr;
begin
  result := '';
  if Self = nil then
    Exit;
  if (nfLevel2 in FFlags) and (namespaceURI = nsURI) and (FNSI.PrefixLen > 0) then
  begin
    Result := Prefix;
    if Original.LookupNamespaceURI(result) = nsURI then
      Exit;
  end;
  if Assigned(FAttributes) then
  begin
    for I := 0 to FAttributes.Length-1 do
    begin
      Attr := TDOMAttr(FAttributes[I]);
      if (Attr.Prefix = 'xmlns') and (Attr.Value = nsURI) then
      begin
        result := Attr.LocalName;
        if Original.LookupNamespaceURI(result) = nsURI then
          Exit;
      end;
    end;
  end;
  result := GetAncestorElement(Self).InternalLookupPrefix(nsURI, Original);
end;

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^.FTypeInfo) then
    result.FDataType := TAttributeDef(src^.FTypeInfo).DataType;
  if Assigned(src^.FNsUri) then
    result.SetNSI(src^.FNsUri^.Key, src^.FColonPos+1);
  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^.FQName^.Key));
      end;
      curr := curr^.FNext;
    end;
  end
  else if src^.FValueStr <> '' then
    result.InternalAppend(doc.CreateTextNode(src^.FValueStr));
end;

function LoadElement(doc: TDOMDocument; src: PNodeData; attrCount: Integer): TDOMElement;
var
  i: Integer;
begin
  TDOMNode(result) := doc.Alloc(TDOMElement);
  result.Create(doc);
  result.FNSI.QName := src^.FQName;
  if Assigned(src^.FNsUri) then
    result.SetNSI(src^.FNsUri^.Key, src^.FColonPos+1);
  for i := 0 to attrCount-1 do
  begin
    Inc(src);
    result.SetAttributeNode(LoadAttribute(doc, src));
    // Attach element to ID map entry if necessary
    if Assigned(src^.FIDEntry) then
      src^.FIDEntry^.Data := Result;
  end;
end;

procedure TDOMElement.RestoreDefaultAttr(AttrDef: TAttributeDef);
var
  Attr: TDOMAttr;
  AttrData: TNodeData;
  nsuri: DOMString;
begin
  if nfDestroying in FOwnerDocument.FFlags then
    Exit;
  { Copy data and maybe fixup namespace fields }
  AttrData := AttrDef.Data^;
  if AttrDef.IsNamespaceDecl then
    AttrData.FNsUri := FOwnerDocument.FStdUri_xmlns
  else if AttrData.FColonPos > 0 then
  begin
    if (AttrData.FColonPos = 3) and (Pos(DOMString('xml'), AttrData.FQName^.Key) = 1) then
      AttrData.FNsUri := FOwnerDocument.FStdUri_xml
    else
    begin
      nsuri := LookupNamespaceURI(Copy(AttrData.FQName^.Key, 1, AttrData.FColonPos));
      // TODO: what if prefix isn't defined?
      AttrData.FNsUri := FOwnerDocument.FNames.FindOrAdd(nsuri);
    end;
  end;
  Attr := LoadAttribute(FOwnerDocument, @AttrData);

  // TODO: this is cheat, should look at config['namespaces'] instead.
  // revisit when it is implemented.
  if nfLevel2 in FFlags then
    Include(Attr.FFlags, nfLevel2);
  // There should be no matching attribute at this point, so non-namespace method is ok
  SetAttributeNode(Attr);
end;

procedure TDOMElement.Normalize;
var
  I: Integer;
begin
  if Assigned(FAttributes) then
    for I := 0 to FAttributes.Length - 1 do
      FAttributes[I].Normalize;
  inherited Normalize;
end;

function TDOMElement.GetAttributes: TDOMNamedNodeMap;
begin
  if FAttributes=nil then
    FAttributes := TAttributeMap.Create(Self);
  Result := FAttributes;
end;

function TDOMElement.GetAttribute(const name: DOMString): DOMString;
var
  Attr: TDOMNode;
begin
  SetLength(Result, 0);
  if Assigned(FAttributes) then
  begin
    Attr := FAttributes.GetNamedItem(name);
    if Assigned(Attr) then
      Result := Attr.NodeValue;
  end;
end;

function TDOMElement.GetAttributeNS(const nsURI, aLocalName: DOMString): DOMString;
var
  Attr: TDOMNode;
begin
  SetLength(Result, 0);
  if Assigned(FAttributes) then
  begin
    Attr := FAttributes.GetNamedItemNS(nsURI, aLocalName);
    if Assigned(Attr) then
      Result := Attr.NodeValue;
  end;
end;

procedure TDOMElement.SetAttribute(const name, value: DOMString);
var
  I: Cardinal;
  attr: TDOMAttr;
begin
  Changing;
  if Attributes.Find(name, I) then
    Attr := FAttributes[I] as TDOMAttr
  else
  begin
    Attr := FOwnerDocument.CreateAttribute(name);
    Attr.FParentNode := Self;
    FAttributes.FList.Insert(I, Attr);
  end;
  attr.NodeValue := value;
end;

procedure TDOMElement.RemoveAttribute(const name: DOMString);
begin
  Changing;
// (note) NamedNodeMap.RemoveNamedItem can raise NOT_FOUND_ERR and we should not.
  if Assigned(FAttributes) then
    FAttributes.InternalRemove(name).Free;
end;

procedure TDOMElement.RemoveAttributeNS(const nsURI,
  aLocalName: DOMString);
begin
  Changing;
  if Assigned(FAttributes) then
    TAttributeMap(FAttributes).InternalRemoveNS(nsURI, aLocalName).Free;
end;

procedure TDOMElement.SetAttributeNS(const nsURI, qualifiedName,
  value: DOMString);
var
  I: Cardinal;
  Attr: TDOMAttr;
  idx, prefIdx: Integer;
  nsidx: PHashItem;
begin
  Changing;
  idx := FOwnerDocument.IndexOfNS(nsURI, True);
  prefIdx := FOwnerDocument.ValidateQName(nsURI, qualifiedName, nsidx);
  if prefIdx < 0 then
    raise EDOMError.Create(-prefIdx, 'Element.SetAttributeNS');

  if TAttributeMap(Attributes).FindNS(idx, Copy(qualifiedName, prefIdx+1, MaxInt), I) then
  begin
    Attr := TDOMAttr(FAttributes[I]);
    // need to reinsert because the nodeName may change
    FAttributes.FList.Delete(I);
  end
  else
  begin
    TDOMNode(Attr) := FOwnerDocument.Alloc(TDOMAttr);
    Attr.Create(FOwnerDocument);
    Attr.FParentNode := Self;
    Attr.FNSI.NSIndex := Word(idx);
    Include(Attr.FFlags, nfLevel2);
  end;
  // keep list sorted by DOM Level 1 name
  FAttributes.Find(qualifiedName, I);
  FAttributes.FList.Insert(I, Attr);
  // TODO: rehash properly, same issue as with Node.SetPrefix()
  Attr.FNSI.QName := FOwnerDocument.FNames.FindOrAdd(DOMPChar(qualifiedName), Length(qualifiedName));
  Attr.FNSI.PrefixLen := Word(prefIdx);
  attr.NodeValue := value;
end;

function TDOMElement.GetAttributeNode(const name: DOMString): TDOMAttr;
begin
  if Assigned(FAttributes) then
    Result := FAttributes.GetNamedItem(name) as TDOMAttr
  else
    Result := nil;
end;

function TDOMElement.GetAttributeNodeNS(const nsURI, aLocalName: DOMString): TDOMAttr;
begin
  if Assigned(FAttributes) then
    Result := FAttributes.GetNamedItemNS(nsURI, aLocalName) as TDOMAttr
  else
    Result := nil;
end;

function TDOMElement.SetAttributeNode(NewAttr: TDOMAttr): TDOMAttr;
begin
  Result := Attributes.SetNamedItem(NewAttr) as TDOMAttr;
end;

function TDOMElement.SetAttributeNodeNS(NewAttr: TDOMAttr): TDOMAttr;
begin
  Result := Attributes.SetNamedItemNS(NewAttr) as TDOMAttr;
end;


function TDOMElement.RemoveAttributeNode(OldAttr: TDOMAttr): TDOMAttr;
var
  Index: Integer;
begin
  Changing;
  Result := OldAttr;
  if Assigned(FAttributes) then
  begin
    Index := FAttributes.FList.IndexOf(OldAttr);
    if Index > -1 then
    begin
      FAttributes.Delete(Index);
      Exit;
    end;
  end;
  raise EDOMNotFound.Create('Element.RemoveAttributeNode');
end;

function TDOMElement.GetElementsByTagName(const name: DOMString): TDOMNodeList;
begin
  Result := FOwnerDocument.GetElementList(Self, '', name, False);
end;

function TDOMElement.GetElementsByTagNameNS(const nsURI, aLocalName: DOMString): TDOMNodeList;
begin
  Result := FOwnerDocument.GetElementList(Self, nsURI, aLocalName, True);
end;

function TDOMElement.hasAttribute(const name: DOMString): Boolean;
begin
  Result := Assigned(FAttributes) and
    Assigned(FAttributes.GetNamedItem(name));
end;

function TDOMElement.hasAttributeNS(const nsURI, aLocalName: DOMString): Boolean;
begin
  Result := Assigned(FAttributes) and
    Assigned(FAttributes.getNamedItemNS(nsURI, aLocalName));
end;

function TDOMElement.HasAttributes: Boolean;
begin
  Result := Assigned(FAttributes) and (FAttributes.Length > 0);
end;

// -------------------------------------------------------
//   Text
// -------------------------------------------------------

function TDOMText.GetNodeType: Integer;
begin
  Result := TEXT_NODE;
end;

function TDOMText.GetNodeName: DOMString;
begin
  Result := '#text';
end;

procedure TDOMText.SetNodeValue(const aValue: DOMString);
begin
  inherited SetNodeValue(aValue);
  // TODO: may analyze aValue, but this will slow things down...
  Exclude(FFlags, nfIgnorableWS);
end;

function TDOMText.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
begin
  Result := ACloneOwner.CreateTextNode(FNodeValue);
end;

function TDOMText.SplitText(offset: LongWord): TDOMText;
var
  L: LongWord;
begin
  Changing;
  L := Length;
  if offset > L then
    raise EDOMIndexSize.Create('Text.SplitText');

  Result := FOwnerDocument.CreateTextNodeBuf(@FNodeValue[offset+1], L-offset, False);
  Result.FFlags := FFlags * [nfIgnorableWS];
  FNodeValue := Copy(FNodeValue, 1, offset);
  if Assigned(FParentNode) then
    FParentNode.InsertBefore(Result, FNextSibling);
end;

function TDOMText.IsElementContentWhitespace: Boolean;
begin
  Result := nfIgnorableWS in FFlags;
end;

// -------------------------------------------------------
//   Comment
// -------------------------------------------------------

function TDOMComment.GetNodeType: Integer;
begin
  Result := COMMENT_NODE;
end;

function TDOMComment.GetNodeName: DOMString;
begin
  Result := '#comment';
end;

function TDOMComment.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
begin
  Result := ACloneOwner.CreateComment(FNodeValue);
end;


// -------------------------------------------------------
//   CDATASection
// -------------------------------------------------------

function TDOMCDATASection.GetNodeType: Integer;
begin
  Result := CDATA_SECTION_NODE;
end;

function TDOMCDATASection.GetNodeName: DOMString;
begin
  Result := '#cdata-section';
end;

function TDOMCDATASection.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
begin
  Result := ACloneOwner.CreateCDATASection(FNodeValue);
end;


// -------------------------------------------------------
//   DocumentType
// -------------------------------------------------------

function TDOMDocumentType.GetNodeType: Integer;
begin
  Result := DOCUMENT_TYPE_NODE;
end;

function TDOMDocumentType.GetNodeName: DOMString;
begin
  Result := FModel.FName;
end;

function TDOMDocumentType.GetPublicID: DOMString;
begin
  Result := FModel.FPublicID;
end;

function TDOMDocumentType.GetSystemID: DOMString;
begin
  Result := FModel.FSystemID;
end;

function TDOMDocumentType.GetInternalSubset: DOMString;
begin
  Result := FModel.FInternalSubset;
end;

function ConvertEntity(Entry: PHashItem; arg: Pointer): Boolean;
var
  this: TDOMDocumentType absolute arg;
  node: TDOMEntity;
begin
  node := TDOMEntity.Create(this.ownerDocument);
  node.FDecl := TEntityDecl(Entry^.Data);
  node.FBaseURI := node.FDecl.FURI;
  node.SetReadOnly(True);
  this.Entities.SetNamedItem(node);
  Result := True;
end;

function ConvertNotation(Entry: PHashItem; arg: Pointer): Boolean;
var
  this: TDOMDocumentType absolute arg;
  node: TDOMNotation;
begin
  node := TDOMNotation.Create(this.ownerDocument);
  node.FDecl := TNotationDecl(Entry^.Data);
  node.FBaseURI := node.FDecl.FURI;
  node.SetReadOnly(True);
  this.Notations.SetNamedItem(node);
  Result := True;
end;

constructor TDOMDocumentType.Create(aOwner: TDOMDocument; aModel: TDTDModel);
begin
  inherited Create(aOwner);
  FModel := aModel.Reference;
  FModel.Entities.ForEach(@ConvertEntity, Self);
  FModel.Notations.ForEach(@ConvertNotation, Self);
  SetReadOnly(True);
end;

destructor TDOMDocumentType.Destroy;
begin
  FModel.Release;
  FEntities.Free;
  FNotations.Free;
  inherited Destroy;
end;

function TDOMDocumentType.GetEntities: TDOMNamedNodeMap;
begin
  if FEntities = nil then
    FEntities := TDOMNamedNodeMap.Create(Self);
  Result := FEntities;
end;

function TDOMDocumentType.GetNotations: TDOMNamedNodeMap;
begin
  if FNotations = nil then
    FNotations := TDOMNamedNodeMap.Create(Self);
  Result := FNotations;
end;

// -------------------------------------------------------
//   Notation
// -------------------------------------------------------

function TDOMNotation.GetNodeType: Integer;
begin
  Result := NOTATION_NODE;
end;

function TDOMNotation.GetNodeName: DOMString;
begin
  Result := FDecl.FName;
end;

function TDOMNotation.GetPublicID: DOMString;
begin
  Result := FDecl.FPublicID;
end;

function TDOMNotation.GetSystemID: DOMString;
begin
  Result := FDecl.FSystemID;
end;

function TDOMNotation.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
begin
  Result := ACloneOwner.Alloc(TDOMNotation);
  TDOMNotation(Result).Create(ACloneOwner);
  TDOMNotation(Result).FDecl := FDecl;
  // notation cannot have children, ignore Deep
end;


// -------------------------------------------------------
//   Entity
// -------------------------------------------------------

function TDOMEntity.GetNodeType: Integer;
begin
  Result := ENTITY_NODE;
end;

function TDOMEntity.GetNodeName: DOMString;
begin
  Result := FDecl.FName;
end;

function TDOMEntity.GetPublicID: DOMString;
begin
  Result := FDecl.FPublicID;
end;

function TDOMEntity.GetSystemID: DOMString;
begin
  Result := FDecl.FSystemID;
end;

function TDOMEntity.GetNotationName: DOMString;
begin
  Result := FDecl.FNotationName;
end;

function TDOMEntity.CloneNode(deep: Boolean; aCloneOwner: TDOMDocument): TDOMNode;
begin
  Result := aCloneOwner.Alloc(TDOMEntity);
  TDOMEntity(Result).Create(aCloneOwner);
  TDOMEntity(Result).FDecl := FDecl;
  if deep then
    CloneChildren(Result, aCloneOwner);
  Result.SetReadOnly(True);
end;

// -------------------------------------------------------
//   EntityReference
// -------------------------------------------------------

function TDOMEntityReference.GetNodeType: Integer;
begin
  Result := ENTITY_REFERENCE_NODE;
end;

function TDOMEntityReference.GetNodeName: DOMString;
begin
  Result := FName;
end;

function TDOMEntityReference.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
begin
  Result := ACloneOwner.CreateEntityReference(FName);
end;

// -------------------------------------------------------
//   ProcessingInstruction
// -------------------------------------------------------

function TDOMProcessingInstruction.CloneNode(deep: Boolean;
  ACloneOwner: TDOMDocument): TDOMNode;
begin
  Result := ACloneOwner.CreateProcessingInstruction(Target, Data);
end;

function TDOMProcessingInstruction.GetNodeType: Integer;
begin
  Result := PROCESSING_INSTRUCTION_NODE;
end;

function TDOMProcessingInstruction.GetNodeName: DOMString;
begin
  Result := FTarget;
end;

function TDOMProcessingInstruction.GetNodeValue: DOMString;
begin
  Result := FNodeValue;
end;

procedure TDOMProcessingInstruction.SetNodeValue(const AValue: DOMString);
begin
  Changing;
  FNodeValue := AValue;
end;

{ TNodePool }

constructor TNodePool.Create(AElementSize: Integer; AElementCount: Integer);
begin
  FElementSize := AElementSize;
  AddExtent(AElementCount);
end;

destructor TNodePool.Destroy;
var
  ext, next: PExtent;
  ptr, ptr_end: PAnsiChar;
  sz: Integer;
begin
  ext := FCurrExtent;
  ptr := PAnsiChar(FCurrBlock) + FElementSize;
  sz := FCurrExtentSize;
  while Assigned(ext) do
  begin
    // call destructors for everyone still there
    ptr_end := PAnsiChar(ext) + sizeof(TExtent) + (sz - 1) * FElementSize;
    while ptr <= ptr_end do
    begin
      if TDOMNode(ptr).FPool = Self then
        TObject(ptr).Destroy;
      Inc(ptr, FElementSize);
    end;
    // dispose the extent and pass to the next one
    next := ext^.Next;
    FreeMem(ext);
    ext := next;
    sz := sz div 2;
    ptr := PAnsiChar(ext) + sizeof(TExtent);
  end;
  inherited Destroy;
end;

procedure TNodePool.AddExtent(AElemCount: Integer);
var
  ext: PExtent;
begin
  Assert((FCurrExtent = nil) or
    (PAnsiChar(FCurrBlock) < PAnsiChar(FCurrExtent) + sizeof(TExtent)));
  Assert(AElemCount > 0);

  GetMem(ext, sizeof(TExtent) + AElemCount * FElementSize);
  ext^.Next := FCurrExtent;
  // point to the beginning of the last block of extent
  FCurrBlock := TDOMNode(PAnsiChar(ext) + sizeof(TExtent) + (AElemCount - 1) * FElementSize);
  FCurrExtent := ext;
  FCurrExtentSize := AElemCount;
end;

function TNodePool.AllocNode(AClass: TDOMNodeClass): TDOMNode;
begin
  if Assigned(FFirstFree) then
  begin
    Result := FFirstFree;       // remove from free list
    FFirstFree := TDOMNode(Result.FPool);
  end
  else
  begin
    if PAnsiChar(FCurrBlock) < PAnsiChar(FCurrExtent) + sizeof(TExtent) then
      AddExtent(FCurrExtentSize * 2);
    Result := FCurrBlock;
    Dec(PAnsiChar(FCurrBlock), FElementSize);
  end;
  AClass.InitInstance(Result);
  Result.FPool := Self;        // mark as used
end;

procedure TNodePool.FreeNode(ANode: TDOMNode);
begin
  ANode.FPool := FFirstFree;
  FFirstFree := ANode;
end;

end.