unit DOM;

{$MODE OBJFPC}
{$M+}

// <http://www.w3.org/TR/REC-DOM-Level-1/>.
// TODO <http://www.w3.org/TR/DOM-Level-2-Core/core.html>.

{
The node types, and which node types they may have as children, are as follows:

    * Document -- Element (maximum of one), ProcessingInstruction, Comment, DocumentType
    * DocumentFragment -- Element, ProcessingInstruction, Comment, Text, CDATASection, EntityReference
    * DocumentType -- no children
    * EntityReference -- Element, ProcessingInstruction, Comment, Text, CDATASection, EntityReference
    * Element -- Element, Text, Comment, ProcessingInstruction, CDATASection, EntityReference
    * Attr -- Text, EntityReference
    * ProcessingInstruction -- no children
    * Comment -- no children
    * Text -- no children
    * CDATASection -- no children
    * Entity -- Element, ProcessingInstruction, Comment, Text, CDATASection, EntityReference
    * Notation -- no children
}

interface
uses classes, type_fixes, contnrs;

const
  NullString { : TDOMString} = '';

type 
  TDOMString = String; // FIXME.
  TDOMImplementation = class;
  
  TNodeType = (ntUnknown, 
               ntElement, 
               ntAttribute, 
               ntText, 
               ntCDATASection, 
               ntEntityReference, 
               ntEntity, 
               ntProcessingInstruction, 
               ntComment, 
               ntDocument, 
               ntDocumentType, 
               ntDocumentFragment, 
               ntNotation, 
               { custom extensions: }
               ntDocumentTypeElement = 100, 
               ntDocumentTypeAttribute);
  
  TDocument = class;
  TNamedNodeMap = class;
  TNodeList = class;
  TNode = class;
  TLoadChildNodes = function(Sender : TObject; aNode : TNode) : TNodeList of object;
  TNode = class 
  protected // don't write.
    fNodeName : TDOMString;
  protected
    procedure EnsureWritable(); inline;
  private
    fNodeType : TNodeType;
    fParentNode : TNode;
    fPreviousSibling : TNode;
    fNextSibling : TNode;
    fOwnerDocument : TDocument;
    fChildNodes : TNodeList;
    fChildNodesRequested : TLoadChildNodes;
    fAttributes : TNamedNodeMap;
    fNodeValue : TDOMString; // TODO better to make "GetNodeValue" etc virtual or not?
  protected
    function GetNodeValue() : TDOMString; inline;
    procedure SetNodeValue(aValue : TDOMString); inline;
    function GetChildNodes() : TNodeList; inline;
    function GetFirstChild() : TNode; inline;
    function GetLastChild() : TNode; inline;
  public
    procedure SetAttributes(aItem : TNamedNodeMap); inline; // used by the XML parser.
  protected
    constructor Create(aOwnerDocument : TDocument; aNodeType : TNodeType; aNodeName : TDOMString);
  public
    destructor Destroy(); override;
    procedure SetChildNodes(aChildNodes : TNodeList); // used by the XML parser (for TDocumentType, TElement, ...).
  protected
    procedure SetRelations(aParentNode, aPreviousSibling, aNextSibling : TNode); //inline;
    procedure RemoveRelations();
  published // our ext.
    property ChildNodesRequested : TLoadChildNodes read fChildNodesRequested write fChildNodesRequested;
  published // official DOM Level 1 core interface:
    property nodeName : TDOMString read fNodeName;
    property nodeValue : TDOMString read GetNodeValue write SetNodeValue; // raises(DOMException) on setting, raises(DOMException) on retrieval.
    property nodeType : TNodeType read fNodeType; // unsigned short?
    property parentNode : TNode read fParentNode;
    property childNodes : TNodeList read GetChildNodes;
    property firstChild : TNode read GetFirstChild;
    property lastChild : TNode read GetLastChild;
    property previousSibling : TNode read fPreviousSibling;
    property nextSibling : TNode read fNextSibling;
    property attributes : TNamedNodeMap read fAttributes;
    property ownerDocument : TDocument read fOwnerDocument;
    function insertBefore(aNewChild, aRefChild : TNode) : TNode; // raises DOMException.
    function replaceChild(aNewChild, aOldChild : TNode) : TNode; // raises DOMException.
    function removeChild(aOldChild : TNode) : TNode; // raises DOMException.
    function appendChild(aNewChild : TNode) : TNode; // raises DOMException.
    function hasChildNodes() : Boolean;
    function cloneNode(aBDeep : Boolean) : TNode; virtual;
  end;

  TAttr = class(TNode)
  private
    fBSpecified : Boolean;
    fValue : TDOMString;
  public
    constructor Create(aOwnerDocument : TDocument; aName : TDOMString; aValue : TDOMString = ''; aBSpecified : Boolean = False);
  published // official DOM Level 1 core interface:
    // the Node attributes parentNode, previousSibling, and nextSibling have a null value for Attr objects.
    
    property name : TDOMString read fNodeName;
    property specified : Boolean read fBSpecified;
    property value : TDOMString read fValue;
  end;
  
  TElement = class(TNode)
  public
    constructor Create(aOwnerDocument : TDocument; aNodeName : TDOMString; aAttributes : TNamedNodeMap);
  published // official DOM Level 1 core interface:
    property tagName : TDOMString read fNodeName; // just use NodeName directly! this property is useless.
    function getAttribute(aName : TDOMString) : TDOMString; inline;
    procedure setAttribute(aName, aValue : TDOMString); // raises DOMException.
    procedure removeAttribute(const aName : TDOMString); // raises DOMException.
    function getAttributeNode(aName : TDOMString) : TAttr;
    procedure setAttributeNode(aAttr : TAttr); // raises DOMException.
    function removeAttributeNode(aOldAttr : TAttr) : TAttr; // raises DOMException.
    function getElementsByTagName(aName : TDOMString) : TNodeList;
    procedure normalize();
  end;
  
  TCharacterData = class(TNode)
  protected
    function GetLength() : TCardinal; inline;
  published // official DOM Level 1 core interface:
    property data : TDOMString read fNodeValue write fNodeValue; // raises(DOMException) on setting, raises(DOMException) on retrieval.
    property length : TCardinal read GetLength;
    function substringData(aOffset, aCount : TCardinal) : TDOMString; // raises(DOMException);
    procedure appendData(aArg : TDOMString); // raises DOMException.
    procedure insertData(aOffset : TCardinal; aArg : TDOMString); // raises DOMException.
    procedure deleteData(aOffset, aCount : TCardinal); // raises DOMException.
    procedure replaceData(aOffset, aCount : TCardinal; aArg : TDOMString); // raises DOMException.
  end;
  
  TText = class(TCharacterData)
  public
    constructor Create(aOwnerDocument : TDocument; aNodeValue : TDOMString);
  protected
    constructor Create(aOwnerDocument : TDocument; aNodeType : TNodeType; aNodeName : TDOMString);
  published // official DOM Level 1 core interface:
    function splitText(aOffset : TCardinal) : TText; // raises DOMException.
  end;
  
  TCDATASection = class(TText)
  public
    constructor Create(aOwnerDocument : TDocument);
  published // official DOM Level 1 core interface:
  end;
  
  TComment = class(TCharacterData)
  public
    constructor Create(aOwnerDocument : TDocument);
  published // official DOM Level 1 core interface:
  end;
  
  TProcessingInstruction = class(TNode)
  private
    // fTarget in NodeName.
    // fData in NodeValue.
  public
    constructor Create(aOwnerDocument : TDocument; aTarget, aData : TDOMString);
  published // official DOM Level 1 core interface:
    property target : TDOMString read fNodeName;
    property data : TDOMString read fNodeValue; // raises DOMException on setting.
  end;
  
  // DOMImplementation.
  // DOMImplementationLS.

  TEntity = class(TNode)
  private
    fPublicID : TDOMString;
    fSystemID : TDOMString;
    fNDATAName : TDOMString; // TODO make this settable?
    fContents : TDOMString;
  public 
    constructor Create(aOwnerDocument : TDocument; aNodeName, aPublicID, aSystemID, aNotationName : TDOMString; aContents : TDOMString);
  published
    property Contents : TDOMString read fContents;
  published // official DOM Level 1 core interface:
    property publicId : TDOMString read fPublicID;
    property systemId : TDOMString read fSystemID;
    property notationName : TDOMString read fNDATAName; // For unparsed entities, the name of the notation for the entity. For parsed entities, this is null. 
  end;

  TNotation = class(TNode)
  private
    fPublicID : TDOMString;
    fSystemID : TDOMString;
  public 
    constructor Create(aOwnerDocument : TDocument; aNodeName, aPublicID, aSystemID : TDOMString);
  published // official DOM Level 1 core interface:
    property publicId : TDOMString read fPublicID;
    property systemId : TDOMString read fSystemID;
  end;

  TDocumentType = class(TNode)
  private
    fEntities : TNamedNodeMap;
    fNotations : TNamedNodeMap;
  public
    constructor Create(aOwnerDocument : TDocument; aNodeName : TDOMString; aChildren : TNodeList {takes ownership});
    //aEntities, aNotations : TNamedNodeMap);
    destructor Destroy(); override;
  published
    procedure AddEntity(aEntity : TEntity);
    function HasEntityP(const aEntityName : TDOMString) : Boolean;
    function GetEntity(const aEntityName : TDOMString) : TEntity;
    procedure AddNotation(aNotation : TNotation);
    function HasNotationP(const aName : TDOMString) : Boolean;
    function GetNotation(const aName : TDOMString) : TNotation;
  published // official DOM Level 1 core interface:
    property name : TDOMString read fNodeName;
    property entities : TNamedNodeMap read fEntities;
    property notations : TNamedNodeMap read fNotations;
  end;
  
  TEntityReference = class(TNode)
  public
    constructor Create(aOwnerDocument : TDocument; aNodeName : TDOMString);
  end;
  
  TDocumentFragment = class(TNode)
  public
    constructor Create(aOwnerDocument : TDocument);
  end;
  
  TDocument = class(TNode)
  private
    fImplementation : TDOMImplementation;
    fDocumentType : TDocumentType;
    fDocumentElement : TElement;
  protected
    procedure SetImplementation(aItem : TDOMImplementation); inline;
  public
    procedure SetDocumentType(aDocumentType : TDocumentType); // used by XML parser (speed optimization so that appendChild doesn't need to be virtual).
    procedure SetDocumentElement(aDocumentElement : TElement); // used by XML parser (speed optimization so that appendChild doesn't need to be virtual).
  public
    constructor Create(); // TODO doctype?
  published // official DOM Level 1 core interface:
    property doctype : TDocumentType read fDocumentType;
    property implementation_ : TDOMImplementation read fImplementation;
    property documentElement : TElement read fDocumentElement;
    function createElement(aTagName : TDOMString) : TElement; // raises DOMException.
    function createDocumentFragment() : TDocumentFragment; // r...
    function createTextNode(aData : TDOMString) : TText; // r...
    function createComment(aData : TDOMString) : TComment; // r...
    function createCDATASection(aData : TDOMString) : TCDATASection; // raises ... 
    function createProcessingInstruction(aTarget : TDOMString; aData : TDOMString) : TProcessingInstruction; // raises...
    function createAttribute(aName : TDOMString) : TAttr; // raises...
    function createEntityReference(aName : TDOMString) : TEntityReference; // raises.
    function getElementsByTagName(aTagName : TDOMString) : TNodeList;
  end;
  // DocumentLS.
  
  // also a read-only version?  
  TNamedNodeMap = class
  private
    fMap : TFPHashObjectList;
  protected
    function GetCount() : TCardinal; inline;
  public
    constructor Create();
    destructor Destroy(); override;
  published // official DOM Level 1 core interface:
    function getNamedItem(aName : TDOMString) : TNode;
    function setNamedItem(aArg : TNode) : TNode; // raises...

    // Removes a node specified by name. If the removed node is an Attr with a default value it is immediately replaced. 
    function removeNamedItem(const aName : TDOMString) : TNode; // raises... DOES NOT FREE THE NODE.

    function item(aIndex : TCardinal) : TNode;
    property length : TCardinal read GetCount;
  end;
  
  TNodeList = class
  private
    fList : TObjectList;
  protected
    function GetLength() : TCardinal;
  public
    constructor Create(aBOwnsElements : Boolean);
    destructor Destroy(); override;
    procedure Append(aNode : TNode); inline;
  public // be careful, doesn't disassociate the node.
    procedure RemoveAt(aIndex : TCardinal);
    procedure ReplaceAt(aIndex : TCardinal; aNewNode : TNode);
    procedure InsertAt(aIndex : TCardinal; aNewNode : TNode);
  published // official DOM Level 1 core interface:
    function item(aIndex : TCardinal) : TNode; inline;
    property length : TCardinal read GetLength;
  end;

  TDOMImplementation = class
    function hasFeature(const aFeature : TDOMString; const aVersion : TDOMString) : Boolean;
  end;                                         
                                           
  // NodeList ?
  // TypeInfo.
  // XMLNS_NAMESPACE.
  
  //'EMPTY_NAMESPACE', 'EMPTY_PREFIX', 
  
  { typing crap: }
  
  TDocumentTypeBodyItem = class
  end;


  // FIXME is it OK that this is a TNode?
  TDocumentTypeElementDeclaration = class(TNode)
  private
    fContent : TDocumentTypeBodyItem;
  public
    property Content : TDocumentTypeBodyItem read fContent;
    constructor Create(aOwnerDocument : TDocument; aNodeName : TDOMString; aContent : TDocumentTypeBodyItem);
  public
    destructor Destroy(); override;
  end;
  
  TDocumentTypeBodyAttributeDefaultImportance = (imOptional, imRequired, imImplied, imFixed);

  TDocumentTypeBodyAttributeDefault = class
  private
    fValue : TDOMString;
    fImportance : TDocumentTypeBodyAttributeDefaultImportance;
  published
    property Importance : TDocumentTypeBodyAttributeDefaultImportance read fImportance write fImportance;
    property Value : TDOMString read fValue write fValue;
    
    constructor Create(aImportance : TDocumentTypeBodyAttributeDefaultImportance; aValue : TDOMString);
  end;

  TDocumentTypeBodyAttributeBaseType = (atString, atID, atIDREF, atIDREFS, atENTITY, atENTITIES, atNMTOKEN, atNMTOKENS, atEnumeration, atNotation);
  // FIXME is it OK that this is a TNode?
  // FIXME split type out.
  TDocumentTypeAttributeDeclaration = class(TNode)
  private
    fBaseType_ : TDocumentTypeBodyAttributeBaseType;
    fDefault_ : TDocumentTypeBodyAttributeDefault;
  protected
    procedure SetDefault(aDefault : TDocumentTypeBodyAttributeDefault);
  public
    property BaseType_ : TDocumentTypeBodyAttributeBaseType read fBaseType_;  // RO.
    property Default_ : TDocumentTypeBodyAttributeDefault read fDefault_ write SetDefault;
    // NodeName = attribute name.
    ElementName : TDOMString; // since XML doesn't just put the !ATTLIST inside the !ELEMENT, we have to remember which ATTLIST is for which ELEMENT here.
    destructor Destroy(); override;
    constructor Create(aOwnerDocument : TDocument; aAttributeName : TDOMString; aElementName : TDOMString; aBaseType_ : TDocumentTypeBodyAttributeBaseType);
  end;

  TDocumentTypeBodyNotationChoice = class(TDocumentTypeAttributeDeclaration)
  private
    fList : TObjectList;
  public
    destructor Destroy(); override;
  published
    constructor Create(aOwnerDocument : TDocument; aAttributeName : TDOMString; aElementName : TDOMString);
    procedure Add(vItem : TNotation);
  end;

  TDocumentTypeAttributeBodyEnumeration = class(TDocumentTypeAttributeDeclaration)
  private
    fList : TStringList;
  public
    destructor Destroy(); override;
  published
    procedure Append(vItem : TDOMString);
    constructor Create(aOwnerDocument : TDocument; aAttributeName : TDOMString; aElementName : TDOMString);
  end;
  
function getDOMImplementation() : TDOMImplementation;
  
implementation
uses sysutils;

type
  TDOMExceptionCode = (
     INDEX_SIZE_ERR     = 1,
     DOMSTRING_SIZE_ERR = 2,
     HIERARCHY_REQUEST_ERR = 3,
     WRONG_DOCUMENT_ERR = 4,
     INVALID_CHARACTER_ERR = 5,
     NO_DATA_ALLOWED_ERR = 6,
     NO_MODIFICATION_ALLOWED_ERR = 7,
     NOT_FOUND_ERR      = 8,
     NOT_SUPPORTED_ERR  = 9,
     INUSE_ATTRIBUTE_ERR = 10
  );
  
  EDOMException = class(Exception)
  private
    fCode : TDOMExceptionCode;
  published
    constructor Create(aCode : TDOMExceptionCode);
    property Code : TDOMExceptionCode read fCode;
  end;

{ TNode }

function TNode.GetNodeValue() : TDOMString; inline;
begin
  Result := fNodeValue;
end;

procedure TNode.SetNodeValue(aValue : TDOMString); inline;
begin
  fNodeValue := aValue;
  // TODO raise TDOMException.Create(NO_MODIFICATION_ALLOWED_ERR);
end;

function TNode.GetChildNodes() : TNodeList; inline;
begin
  if not Assigned(fChildNodes) and Assigned(fChildNodesRequested) then
    fChildNodes := fChildNodesRequested(Self, Self);
  if not Assigned(fChildNodes) then
    fChildNodes := TNodeList.Create(True);
    
  Result := fChildNodes;
end;

function TNode.GetFirstChild() : TNode; inline; 
var
  vChildNodes : TNodeList;
begin
  vChildNodes := GetChildNodes();
  if Assigned(vChildNodes) and (vChildNodes.length > 0) then
    Result := vChildNodes.item(0)
  else
    Result := nil;
end;

function TNode.GetLastChild() : TNode; inline;
var
  vChildNodes : TNodeList;
begin
  vChildNodes := GetChildNodes();
  if Assigned(vChildNodes) and (vChildNodes.length > 0) then
    Result := vChildNodes.item(vChildNodes.length - 1)
  else
    Result := nil;
end;

function TNode.hasChildNodes() : Boolean;
var
  vChildNodes : TNodeList;
begin
  vChildNodes := GetChildNodes();
  if Assigned(vChildNodes) then
    Result := vChildNodes.length > 0
  else // oops.
    Result := False;
end;

constructor TNode.Create(aOwnerDocument : TDocument; aNodeType : TNodeType; aNodeName : TDOMString);
begin
  fOwnerDocument := aOwnerDocument;
  fNodeType := aNodeType;
  fNodeName := aNodeName;
end;

procedure TNode.EnsureWritable(); inline;
begin
  // raise TDOMException.Create(NO_MODIFICATION_ALLOWED_ERR);
end;

procedure TNode.SetRelations(aParentNode, aPreviousSibling, aNextSibling : TNode); //inline;
begin
  fParentNode := aParentNode;
  fPreviousSibling := aPreviousSibling;
  fNextSibling := aNextSibling;
end;

procedure TNode.RemoveRelations();
begin
  if Assigned(fParentNode) then begin
    fParentNode.removeChild(Self);
    fParentNode := nil;
    assert(fNextSibling = nil);
    assert(fPreviousSibling = nil);
  end;
end;


procedure TNode.SetChildNodes(aChildNodes : TNodeList);
begin
  FreeAndNil(fChildNodes);
  fChildNodes := aChildNodes;
end;

destructor TNode.Destroy();
begin
  RemoveRelations();
  FreeAndNil(fChildNodes);
  FreeAndNil(fAttributes);
  inherited Destroy();
end;

procedure TNode.SetAttributes(aItem : TNamedNodeMap); inline;
begin
  if Assigned(fAttributes) then
    FreeAndNil(fAttributes);
    
  fAttributes := aItem;
end;

{
Adds the node newChild to the end of the list of children of this node. If the newChild is already in the tree, it is first removed.

Parameters
    newChild   The node to add.

    If it is a DocumentFragment object, the entire contents of the document fragment are moved into the child list of this node.

Return Value
    The node added.

Exceptions

    DOMException

        HIERARCHY_REQUEST_ERR: Raised if this node is of a type that does not allow children of the type of the newChild node, or if the node to append is one of this node's ancestors.

        WRONG_DOCUMENT_ERR: Raised if newChild was created from a different document than the one that created this node.

        NO_MODIFICATION_ALLOWED_ERR: Raised if this node is readonly.
}
function TNode.appendChild(aNewChild : TNode) : TNode; // raises DOMException.
var
  vChildNodes : TNodeList;
  vPrevious : TNode;
begin
  if Assigned(fParentNode) then begin
    RemoveRelations();
  end;
  
  Result := aNewChild;
  // FIXME handle DocumentFragment.
  vChildNodes := GetChildNodes();
  vPrevious := nil;
  if vChildNodes.length > 0 then
    vPrevious := vChildNodes.item(vChildNodes.length - 1);

  aNewChild.SetRelations(Self, vPrevious, nil);
  vChildNodes.Append(aNewChild);
end;

function TNode.insertBefore(aNewChild, aRefChild : TNode) : TNode; // raises DOMException.
var
  vChildNodes : TNodeList;
  vPrevious : TNode;
  vNode : TNode;
  vChildIndex : TCardinal;
begin
  // FIXME HIERARCHY_REQUEST_ERR.
  // FIXME WRONG_DOCUMENT_ERR.

  Result := aNewChild;
  EnsureWritable();
  vChildNodes := GetChildNodes();
  vPrevious := nil;
  if vChildNodes.length > 0 then
    for vChildIndex := 0 to vChildNodes.length - 1 do begin
      vNode := vChildNodes.item(vChildIndex);
      if vNode = aRefChild then begin
        aNewChild.SetRelations(Self, vPrevious, vNode);
        vChildNodes.InsertAt(vChildIndex, aNewChild);
        Exit;
      end;
      vPrevious := vNode;
    end;
  raise EDOMException.Create(NOT_FOUND_ERR);
end;

{ Replaces the child node oldChild with newChild in the list of children, and returns the oldChild node. If the newChild is already in the tree, it is first removed. }
function TNode.replaceChild(aNewChild, aOldChild : TNode) : TNode; // raises DOMException.
var
  vChildNodes : TNodeList;
  vNode : TNode;
  vPrevious : TNode;
  vNext : TNode;
  vChildIndex : TCardinal;
begin
  // FIXME HIERARCHY_REQUEST_ERR.
  // FIXME WRONG_DOCUMENT_ERR.
  
  Result := nil;

  EnsureWritable();
  vChildNodes := GetChildNodes();
  
  removeChild(aNewChild);
  
  if vChildNodes.length > 0 then
    for vChildIndex := 0 to vChildNodes.length - 1 do begin
      vNode := vChildNodes.item(vChildIndex);
      if vNode = aOldChild then begin
        vPrevious := vNode.previousSibling;
        vNext := vNode.nextSibling;
        
        vNode.RemoveRelations();
        
        aNewChild.SetRelations(Self, vPrevious, vNext);
        
        vChildNodes.ReplaceAt(vChildIndex, aNewChild);
        Result := aOldChild;
        Exit;
      end;
    end;

  raise EDOMException.Create(NOT_FOUND_ERR);
end;

function TNode.removeChild(aOldChild : TNode) : TNode; // raises DOMException.
var
  vChildNodes : TNodeList;
  vChildIndex : TCardinal;
  vNode : TNode;
begin
  EnsureWritable();
  vChildNodes := GetChildNodes();

  if vChildNodes.length > 0 then
    for vChildIndex := 0 to vChildNodes.length - 1 do begin
      vNode := vChildNodes.item(vChildIndex);
      if vNode = aOldChild then begin
        vNode.RemoveRelations();
        vChildNodes.RemoveAt(vChildIndex);
        Result := vNode;
      end;
    end;
end;

function TNode.cloneNode(aBDeep : Boolean) : TNode;
begin
  // FIXME!
  Result := nil;
end;

{ TAttr }

constructor TAttr.Create(aOwnerDocument : TDocument; aName : TDOMString; aValue : TDOMString = ''; aBSpecified : Boolean = False);
begin
  inherited Create(aOwnerDocument, ntAttribute, aName);
  fBSpecified := aBSpecified;
  fValue := aValue;
end;

{ TElement }

constructor TElement.Create(aOwnerDocument : TDocument; aNodeName : TDOMString; aAttributes : TNamedNodeMap);
begin
  inherited Create(aOwnerDocument, ntElement, aNodeName);
  SetAttributes(aAttributes);
end;

function TElement.getAttribute(aName : TDOMString) : TDOMString; inline;
var
  vNode : TNode;
begin
  vNode := fAttributes.getNamedItem(aName);
  if Assigned(vNode) then
    Result := vNode.NodeValue
  else
    Result := NullString;
end;
    
procedure TElement.setAttribute(aName, aValue : TDOMString); // raises DOMException.
begin
  EnsureWritable();
  fAttributes.setNamedItem(TAttr.Create(OwnerDocument, aName, aValue));
end;

procedure TElement.removeAttribute(const aName : TDOMString); // raises DOMException.
begin
  EnsureWritable();
  fAttributes.removeNamedItem(aName);
end;

function TElement.getAttributeNode(aName : TDOMString) : TAttr; inline;
begin
  Result := TAttr(fAttributes.getNamedItem(aName));
end;

procedure TElement.setAttributeNode(aAttr : TAttr); // raises DOMException.
begin
  EnsureWritable();
  fAttributes.setNamedItem(aAttr);
end;

function TElement.removeAttributeNode(aOldAttr : TAttr) : TAttr; // raises DOMException.
begin
  EnsureWritable();

  assert(Assigned(aOldAttr));
  
  if fAttributes.getNamedItem(aOldAttr.Name) = aOldAttr then
    fAttributes.removeNamedItem(aOldAttr.Name) // FIXME is that enough?
  else
    raise EDOMException.Create(NOT_FOUND_ERR);
  Result := aOldAttr;
end;

function TElement.getElementsByTagName(aName : TDOMString) : TNodeList;
var
  vChildNodes : TNodeList;
  vChildIndex : TCardinal;
begin
  Result := TNodeList.Create(False);
  try
    vChildNodes := GetChildNodes();
    if vChildNodes.length > 0 then
      for vChildIndex := 0 to vChildNodes.length - 1 do begin
      end;
  except
    FreeAndNil(Result);
    raise;
  end;
end;

{Puts all Text nodes in the full depth of the sub-tree underneath this Element into a "normal" form where only markup (e.g., tags, comments, processing instructions, CDATA sections, and entity references) separates Text nodes, i.e., there are no adjacent Text nodes. This can be used to ensure that the DOM view of a document is the same as if it were saved and re-loaded, and is useful when operations (such as XPointer lookups) that depend on a particular document tree structure are to be used.}
procedure TElement.normalize();
var
  vChildIndex : TCardinal;
  vChildNodes : TNodeList;
  vPreviousNode : TNode;
  vNode : TNode;
begin
  vChildNodes := GetChildNodes();
  vPreviousNode := nil;
  vChildIndex := 0;
  if vChildNodes.length > 0 then
    while vChildIndex < vChildNodes.length do begin
      vNode := vChildNodes.item(vChildIndex);
      if (vNode is TText) and (vPreviousNode <> nil) and (vPreviousNode is TText) then begin // adjacent text nodes.
        // merge into previous node:
        TText(vPreviousNode).appendData(TText(vNode).data);
        vChildNodes.RemoveAt(vChildIndex);
      end else begin
        vPreviousNode := vNode;
        Inc(vChildIndex);
      end;
    end;
end;

{ TCharacterData }

function TCharacterData.GetLength() : TCardinal; inline;
begin
  Result := system.Length(fNodeValue); // FIXME encoding?
end;

function TCharacterData.substringData(aOffset, aCount : TCardinal) : TDOMString; // raises(DOMException);
begin
  Result := Copy(fNodeValue, aOffset + 1, aCount);
end;

procedure TCharacterData.appendData(aArg : TDOMString); // raises DOMException.
begin
  fNodeValue := fNodeValue + aArg;
end;

procedure TCharacterData.insertData(aOffset : TCardinal; aArg : TDOMString); // raises DOMException.
begin
  Insert(aArg, fNodeValue, aOffset + 1);
end;

procedure TCharacterData.deleteData(aOffset, aCount : TCardinal); // raises DOMException.
begin
  Delete(fNodeValue, aOffset + 1, aCount);
end;

procedure TCharacterData.replaceData(aOffset, aCount : TCardinal; aArg : TDOMString); // raises DOMException.
begin
  // TODO optimize.
  Delete(fNodeValue, aOffset + 1, aCount);
  Insert(aArg, fNodeValue, aOffset + 1);
end;

{ TDocument }

constructor TDocument.Create();
begin
  inherited Create(nil{???}, ntDocument, '#document');
end;

procedure TDocument.SetDocumentType(aDocumentType : TDocumentType);
begin
  fDocumentType := aDocumentType;
end;

procedure TDocument.SetDocumentElement(aDocumentElement : TElement);
begin
  fDocumentElement := aDocumentElement;
end;

procedure TDocument.SetImplementation(aItem : TDOMImplementation); inline;
begin
  fImplementation := aItem;
end;

function TDocument.createElement(aTagName : TDOMString) : TElement; // raises DOMException.
begin
  Result := TElement.Create(Self, aTagName, TNamedNodeMap.Create());
end;

function TDocument.createDocumentFragment() : TDocumentFragment; // r...
begin
  Result := TDocumentFragment.Create(Self);
end;

function TDocument.createTextNode(aData : TDOMString) : TText; // r...
begin
  Result := TText.Create(Self, aData);
end;

function TDocument.createComment(aData : TDOMString) : TComment; // r...
begin
  Result := TComment.Create(Self);
end;

function TDocument.createCDATASection(aData : TDOMString) : TCDATASection; // raises ... 
begin
  Result := TCDATASection.Create(Self);
end;

function TDocument.createProcessingInstruction(aTarget : TDOMString; aData : TDOMString) : TProcessingInstruction; // raises...
begin
  Result := TProcessingInstruction.Create(Self, aTarget, aData);
end;

function TDocument.createAttribute(aName : TDOMString) : TAttr; // raises...
begin
  Result := TAttr.Create(Self, aName);
end;

function TDocument.createEntityReference(aName : TDOMString) : TEntityReference; // raises.
begin
  Result := TEntityReference.Create(Self, aName);
end;

function TDocument.getElementsByTagName(aTagName : TDOMString) : TNodeList;
begin
  // FIXME.
  Result := nil;
end;

{ TEntity }

constructor TEntity.Create(aOwnerDocument : TDocument; aNodeName, aPublicID, aSystemID, aNotationName : TDOMString; aContents : TDOMString);
begin
  inherited Create(aOwnerDocument, ntEntity, aNodeName);
  fPublicID := aPublicID;
  fSystemID := aSystemID;
  fNDATAName := aNotationName;
  fContents := aContents;
end;

{ TDocumentType }

constructor TDocumentType.Create(aOwnerDocument : TDocument; aNodeName : TDOMString; aChildren : TNodeList {takes ownership});
var
  vChildIndex : TCardinal;
  vChildItem : TNode;
begin
  inherited Create(aOwnerDocument, ntDocumentType, aNodeName);
  SetChildNodes(aChildren);
  fEntities := TNamedNodeMap.Create();
  fNotations := TNamedNodeMap.Create();
  
  if aChildren.length > 0 then
    for vChildIndex := 0 to aChildren.length - 1 do begin
      vChildItem := aChildren.item(vChildIndex);
      if vChildItem is TEntity then begin
        // TODO check dupes?
        fEntities.setNamedItem(vChildItem);
      end else if vChildItem is TNotation then begin
        // TODO check dupes?
        fNotations.setNamedItem(vChildItem);
      end;
    end;
end;

destructor TDocumentType.Destroy();
begin
  FreeAndNil(fEntities);
  FreeAndNil(fNotations);
  inherited Destroy();
end;

procedure TDocumentType.AddEntity(aEntity : TEntity);
begin
  fEntities.setNamedItem(aEntity);
end;

function TDocumentType.HasEntityP(const aEntityName : TDOMString) : Boolean;
begin
  Result := fEntities.getNamedItem(aEntityName) <> nil;
end;

function TDocumentType.GetEntity(const aEntityName : TDOMString) : TEntity;
begin
  Result := fEntities.getNamedItem(aEntityName) as TEntity;
end;

procedure TDocumentType.AddNotation(aNotation : TNotation);
begin
  fNotations.setNamedItem(aNotation);
end;

function TDocumentType.HasNotationP(const aName : TDOMString) : Boolean;
begin
  Result := GetNotation(aName) <> nil;
end;

function TDocumentType.GetNotation(const aName : TDOMString) : TNotation;
begin
  Result := fNotations.getNamedItem(aName) as TNotation;
end;

{ TDocumentFragment }

constructor TDocumentFragment.Create(aOwnerDocument : TDocument);
begin
  inherited Create(aOwnerDocument, ntDocumentFragment, '#document-fragment');
end;

{ TComment }

constructor TComment.Create(aOwnerDocument : TDocument);
begin
  inherited Create(aOwnerDocument, ntComment, '#comment');
end;

{ TCDATASection }

constructor TCDATASection.Create(aOwnerDocument : TDocument);
begin
  inherited Create(aOwnerDocument, ntCDATASection, '#cdata-section');
end;

{ TText }

constructor TText.Create(aOwnerDocument : TDocument; aNodeValue : TDOMString);
begin
  inherited Create(aOwnerDocument, ntText, '#text');
  SetNodeValue(aNodeValue);
end;

constructor TText.Create(aOwnerDocument : TDocument; aNodeType : TNodeType; aNodeName : TDOMString);
begin
  inherited Create(aOwnerDocument, aNodeType, aNodeName);
end;

function TText.splitText(aOffset : TCardinal) : TText; // raises DOMException.
var
  vFirstString : TDOMString;
  vSecondString : TDOMString;
begin
  EnsureWritable();

  //if aOffset < Self.length then begin
  vFirstString := Self.substringData(0, aOffset);
  vSecondString := Self.substringData(aOffset, Self.length);
  Self.data := vSecondString;
  Result := OwnerDocument.createTextNode(vFirstString);
  if Assigned(ParentNode) then
    ParentNode.insertBefore(Result, Self)
  else
    ; // FIXME ????
end;


{ TProcessingInstruction }

constructor TProcessingInstruction.Create(aOwnerDocument : TDocument; aTarget, aData : TDOMString);
begin
  inherited Create(aOwnerDocument, ntProcessingInstruction, aTarget);
  SetNodeValue(aData);
end;

{ TEntityReference }

constructor TEntityReference.Create(aOwnerDocument : TDocument; aNodeName : TDOMString);
begin
  inherited Create(aOwnerDocument, ntEntityReference, aNodeName);
end;

{ TDOMImplementation }

function TDOMImplementation.hasFeature(const aFeature : TDOMString; const aVersion : TDOMString) : Boolean;
begin
  Result := False;
end;

{ TNodeList }

constructor TNodeList.Create(aBOwnsElements : Boolean);
begin
  fList := TObjectList.Create(aBOwnsElements);
end;

function TNodeList.GetLength() : TCardinal; inline;
begin
  Result := fList.Count;
end;

function TNodeList.item(aIndex : TCardinal) : TNode; inline;
begin
  Result := TNode(fList[aIndex]);
end;

procedure TNodeList.Append(aNode : TNode); inline;
begin
  fList.Add(aNode);
end;

procedure TNodeList.RemoveAt(aIndex : TCardinal);
begin
  fList.Delete(aIndex);
end;

procedure TNodeList.ReplaceAt(aIndex : TCardinal; aNewNode : TNode);
begin
  // FIXME does this work? (i.e. Free the old node?)
  fList[aIndex] := aNewNode;
end;

procedure TNodeList.InsertAt(aIndex : TCardinal; aNewNode : TNode);
begin
  fList.Insert(aIndex, aNewNode);
end;

destructor TNodeList.Destroy();
begin
  FreeAndNil(fList);
  inherited Destroy();
end;

{ EDOMException }

constructor EDOMException.Create(aCode : TDOMExceptionCode);
var
  vString : String;
begin
  vString := 'Unknown error';
  case aCode of
     INDEX_SIZE_ERR: vString := 'index size error.';
     DOMSTRING_SIZE_ERR: vString := 'string size error.';
     HIERARCHY_REQUEST_ERR: vString := 'hierarchy request error.';
     WRONG_DOCUMENT_ERR: vString := 'wrong document.';
     INVALID_CHARACTER_ERR: vString := 'invalid character.';
     NO_DATA_ALLOWED_ERR: vString := 'no data allowed.';
     NO_MODIFICATION_ALLOWED_ERR: vString := 'no modification allowed.';
     NOT_FOUND_ERR: vString := 'not found.';
     NOT_SUPPORTED_ERR: vString := 'not supported.';
     INUSE_ATTRIBUTE_ERR: vString := 'attribute is in use.';
  end;
  fCode := aCode;
  inherited Create(vString);
end;

{ TNamedNodeMap }

constructor TNamedNodeMap.Create();
begin
  fMap := TFPHashObjectList.Create(True);
end;

destructor TNamedNodeMap.Destroy();
begin
  FreeAndNil(fMap);
  inherited Destroy();
end;

function TNamedNodeMap.GetCount() : TCardinal; inline;
begin
  Result := fMap.Count;
end;

function TNamedNodeMap.getNamedItem(aName : TDOMString) : TNode;
begin
  Result := fMap.Find(aName) as TNode;
end;

function TNamedNodeMap.setNamedItem(aArg : TNode) : TNode; // raises...
begin
  // FIXME check write protection.

  Result := removeNamedItem(aArg.NodeName);
  fMap.Add(aArg.NodeName, aArg);
end;

// Removes a node specified by name. If the removed node is an Attr with a default value it is immediately replaced. 
function TNamedNodeMap.removeNamedItem(const aName : TDOMString) : TNode; // raises... DOES NOT FREE THE NODE.
var
  i : Integer;
begin
  i := fMap.FindIndexOf(aName);
  if i <> -1 then begin
    fMap.OwnsObjects := False;
    Result := fMap.Items[i] as TNode;
    fMap.Delete(i);
    fMap.OwnsObjects := True;
  end;
end;

function TNamedNodeMap.item(aIndex : TCardinal) : TNode;
begin
  Result := fMap.Items[aIndex] as TNode;
end;

{ TDocumentTypeElementDeclaration }

constructor TDocumentTypeElementDeclaration.Create(aOwnerDocument : TDocument; aNodeName : TDOMString; aContent : TDocumentTypeBodyItem);
begin
  inherited Create(aOwnerDocument, ntDocumentTypeElement, aNodeName);
  fContent := aContent;
end;

destructor TDocumentTypeElementDeclaration.Destroy();
begin
  FreeAndNil(Self.Content);
  inherited Destroy();
end;


{ TDocumentTypeAttributeDeclaration }

constructor TDocumentTypeAttributeDeclaration.Create(aOwnerDocument : TDocument; aAttributeName : TDOMString; aElementName : TDOMString; aBaseType_ : TDocumentTypeBodyAttributeBaseType);
begin
  inherited Create(aOwnerDocument, ntDocumentTypeAttribute, aAttributeName);
  ElementName := aElementName;
  fBaseType_ := aBaseType_;
  fDefault_ := nil;
end;

procedure TDocumentTypeAttributeDeclaration.SetDefault(aDefault : TDocumentTypeBodyAttributeDefault);
begin
  if fDefault_ = aDefault then
    Exit;
    
  if Assigned(fDefault_) then
    FreeAndNil(fDefault_);
    
  fDefault_ := aDefault;
end;

destructor TDocumentTypeAttributeDeclaration.Destroy();
begin
  FreeAndNil(Self.fDefault_);
  //FreeAndNil(fBaseType_);
  inherited Destroy();
end;

{ TNotation }

constructor TNotation.Create(aOwnerDocument : TDocument; aNodeName, aPublicID, aSystemID : TDOMString);
begin
  inherited Create(aOwnerDocument, ntNotation, aNodeName);
  fPublicID := aPublicID;
  fSystemID := aSystemID;
end;

{ TDocumentTypeBodyAttributeDefault }

constructor TDocumentTypeBodyAttributeDefault.Create(aImportance : TDocumentTypeBodyAttributeDefaultImportance; aValue : TDOMString);
begin
  fImportance := aImportance;
  fValue := aValue;
end;

{ TDocumentTypeBodyNotationChoice }

destructor TDocumentTypeBodyNotationChoice.Destroy();
begin
  FreeAndNil(fList);
  inherited Destroy();
end;

constructor TDocumentTypeBodyNotationChoice.Create(aOwnerDocument : TDocument; aAttributeName : TDOMString; aElementName : TDOMString);
begin
  inherited Create(aOwnerDocument, aAttributeName, aElementName, atNotation);
  fList := TObjectList.Create(True);
end;

procedure TDocumentTypeBodyNotationChoice.Add(vItem : TNotation);
begin
  fList.Add(vItem);
end;

{ TDocumentTypeAttributeBodyEnumeration }

destructor TDocumentTypeAttributeBodyEnumeration.Destroy();
begin
  FreeAndNil(fList);
  inherited Destroy();
end;

constructor TDocumentTypeAttributeBodyEnumeration.Create(aOwnerDocument : TDocument; aAttributeName : TDOMString; aElementName : TDOMString);
begin
  inherited Create(aOwnerDocument, aAttributeName, aElementName, atEnumeration);
  fList := TStringList.Create();
end;

procedure TDocumentTypeAttributeBodyEnumeration.Append(vItem : TDOMString);
begin
  fList.Add(vItem);
end;

var
  vDOMImplementation : TDOMImplementation = nil;

function getDOMImplementation() : TDOMImplementation;
begin
  if not Assigned(vDOMImplementation) then
    vDOMImplementation := TDOMImplementation.Create();
    
  Result := vDOMImplementation;
end;

initialization
finalization
  FreeAndNil(vDOMImplementation);

end.