paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-31 22:10:55 +01:00
Code Issues Packages Projects Releases Wiki Activity
fc24b68aa6
lazarus/components/lazutils/laz2_dom.pas
mattias f9799efe90 lazutils: less hints 
git-svn-id: trunk@59216 -
2018-10-01 15:13:34 +00:00

3738 lines
104 KiB
ObjectPascal
Raw Blame History

{
**********************************************************************
This file is part of LazUtils.
It is copied from FCL unit dom svn revision 15251 and adapted to use
UTF8 instead of widestrings by Mattias Gaertner.
See the file COPYING.FPC, included in this distribution,
for details about the license.
**********************************************************************
Implementation of DOM interfaces
Copyright (c) 1999-2000 by Sebastian Guenther, sg@freepascal.org
Modified in 2006 by Sergei Gorelkin, sergei_gorelkin@mail.ru
}
{
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 Laz2_DOM;
{$ifdef fpc}
{$MODE objfpc}{$H+}
{$endif}
interface
uses
SysUtils, Classes, laz2_xmlutils;
// -------------------------------------------------------
// 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;
TDOMNode = class;
TDOMAttr = class;
TDOMElement = class;
TDOMText = class;
TDOMComment = class;
TDOMCDATASection = class;
TDOMDocumentType = class;
TDOMEntityReference = class;
TDOMProcessingInstruction = class;
TDOMAttrDef = class;
TNodePool = class;
PNodePoolArray = ^TNodePoolArray;
TNodePoolArray = array[0..MaxInt div sizeof(Pointer)-1] of TNodePool;
{$ifndef fpc}
TFPList = TList;
{$endif}
// -------------------------------------------------------
// DOMString
// -------------------------------------------------------
TSetOfChar = set of Char;
DOMString = AnsiString;
DOMPChar = PChar;
DOMChar = Char;
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
);
TNodeFlags = set of TNodeFlagEnum;
{ TDOMNodeEnumerator }
TDOMNodeEnumerator = class
private
FNode: TDOMNode;
FCurrent: TDOMNode;
public
constructor Create(Node: TDOMNode);
function MoveNext: boolean;
property Current: TDOMNode read FCurrent;
end;
{ TDOMNodeAllChildEnumerator }
TDOMNodeAllChildEnumerator = class
private
FNode: TDOMNode;
FCurrent: TDOMNode;
FEnd: TDOMNode;
public
constructor Create(Node: TDOMNode);
function MoveNext: boolean;
property Current: TDOMNode read FCurrent;
function GetEnumerator: TDOMNodeAllChildEnumerator; // including grand children
end;
{ TDOMNode }
TDOMNode = class
protected
FPool: TObject;
FFlags: TNodeFlags;
FParentNode: TDOMNode;
FPreviousSibling, FNextSibling: TDOMNode;
FOwnerDocument: TDOMDocument;
function GetNodeName: DOMString; virtual; abstract;
function GetNodeValue: DOMString; virtual;
procedure SetNodeValue(const {%H-}AValue: DOMString); virtual;
function GetFirstChild: TDOMNode; virtual;
function GetLastChild: 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 {%H-}Value: DOMString); virtual;
function GetOwnerDocument: TDOMDocument; virtual;
function GetBaseURI: DOMString;
procedure SetReadOnly(Value: Boolean);
procedure Changing;
public
constructor Create(AOwner: TDOMDocument);
destructor Destroy; override;
procedure FreeInstance; override;
function GetChildNodes: TDOMNodeList;
function GetChildCount: SizeInt; virtual;
property NodeName: DOMString read GetNodeName;
property NodeValue: DOMString read GetNodeValue write SetNodeValue;
property NodeType: Integer read GetNodeType;
property ParentNode: TDOMNode read FParentNode;
property FirstChild: TDOMNode read GetFirstChild;
property LastChild: TDOMNode read GetLastChild;
property ChildNodes: TDOMNodeList read GetChildNodes;
property PreviousSibling: TDOMNode read FPreviousSibling;
property NextSibling: TDOMNode read FNextSibling;
property Attributes: TDOMNamedNodeMap read GetAttributes;
property OwnerDocument: TDOMDocument read GetOwnerDocument;
function GetEnumerator: TDOMNodeEnumerator; // all children excluding grand children
function GetEnumeratorAllChildren: TDOMNodeAllChildEnumerator; // all children including grand children
function GetNextNode: TDOMNode; // first child, then next sibling, then next sibling of parent, ...
function GetNextNodeSkipChildren: TDOMNode; // first next sibling, then next sibling of parent, ...
function GetPreviousNode: TDOMNode; // the reverse of GetNextNode
function GetLastLeaf: TDOMNode; // get last child of last child of ...
function GetLevel: SizeInt; // root node has 0
function InsertBefore({%H-}NewChild, {%H-}RefChild: TDOMNode): TDOMNode; virtual;
function ReplaceChild({%H-}NewChild, {%H-}OldChild: TDOMNode): TDOMNode; virtual;
function DetachChild({%H-}OldChild: TDOMNode): TDOMNode; virtual;
function RemoveChild(OldChild: TDOMNode): TDOMNode;
function AppendChild(NewChild: TDOMNode): TDOMNode;
function HasChildNodes: Boolean; virtual;
function CloneNode(deep: Boolean): TDOMNode; overload;
// 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({%H-}deep: Boolean; {%H-}ACloneOwner: TDOMDocument): TDOMNode; overload; virtual;
function FindNode(const {%H-}ANodeName: DOMString): TDOMNode; virtual;
function CompareName(const name: DOMString): Integer; virtual;
property Flags: TNodeFlags read FFlags;
end;
TDOMNodeClass = class of TDOMNode;
{ 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 }
TDOMNode_WithChildren = class(TDOMNode)
protected
FFirstChild, FLastChild: 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 GetChildCount: SizeInt; override;
function FindNode(const ANodeName: DOMString): TDOMNode; override;
procedure InternalAppend(NewChild: TDOMNode);
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({%H-}aNode: TDOMNode): TFilterResult; virtual;
procedure BuildList; virtual; deprecated 'Use NodeFilter instead.';
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 }
TDOMNamedNodeMap = class(TObject)
protected
FOwner: TDOMNode;
FNodeType: Integer;
FSortedList: TFPList; // list of TDOMNode sorted via CompareName
FPosList: TFPList; // list of TDOMNode not sorted
function GetPosItem(index: LongWord): TDOMNode;
function GetSortedItem(index: LongWord): TDOMNode;
function GetLength: LongWord;
function FindSorted(const name: DOMString; out Index: LongWord): Boolean;
function DeleteSorted(index: LongWord): TDOMNode;
procedure RestoreDefault(const name: DOMString);
function InternalRemove(const name: DOMString): TDOMNode;
function ValidateInsert(arg: TDOMNode): Integer;
public
constructor Create(AOwner: TDOMNode; ANodeType: Integer);
destructor Destroy; override;
function GetNamedItem(const name: DOMString): TDOMNode;
function SetNamedItem(arg: TDOMNode): TDOMNode;
function RemoveNamedItem(const name: DOMString): TDOMNode;
// Introduced in DOM Level 2:
function getNamedItemNS(const {%H-}namespaceURI, {%H-}localName: DOMString): TDOMNode; virtual;
function setNamedItemNS(arg: TDOMNode): TDOMNode; virtual;
function removeNamedItemNS(const {%H-}namespaceURI,{%H-}localName: DOMString): TDOMNode; virtual;
property Item[index: LongWord]: TDOMNode read GetPosItem; default;
property SortedItem[index: LongWord]: TDOMNode read GetSortedItem;
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_WithChildren)
protected
FIDList: THashTable;
FRevision: Integer;
FXML11: Boolean;
FImplementation: TDOMImplementation;
FNamespaces: TNamespaces;
FNames: THashTable;
FEmptyNode: TDOMElement;
FNodeLists: THashTable;
FMaxPoolSize: Integer;
FPools: PNodePoolArray;
FDocumentURI: DOMString;
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 {%H-}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;
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 {%H-}data: DOMString): TDOMCDATASection;
virtual;
function CreateProcessingInstruction(const {%H-}target, {%H-}data: DOMString):
TDOMProcessingInstruction; virtual;
function CreateAttribute(const name: DOMString): TDOMAttr;
function CreateAttributeBuf(Buf: DOMPChar; Length: Integer): TDOMAttr;
function CreateAttributeDef(Buf: DOMPChar; Length: Integer): TDOMAttrDef;
function CreateEntityReference(const {%H-}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;
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 FDocumentURI write FDocumentURI;
// Extensions to DOM interface:
constructor Create;
destructor Destroy; override;
function AddID(Attr: TDOMAttr): Boolean;
property Names: THashTable read FNames;
end;
TXMLDocument = class(TDOMDocument)
private
FXMLVersion: DOMString;
procedure SetXMLVersion(const aValue: DOMString);
public
// These fields are extensions to the DOM interface:
Encoding, StylesheetType, StylesheetHRef: DOMString;
function CreateCDATASection(const data: DOMString): TDOMCDATASection; override;
function CreateProcessingInstruction(const target, data: DOMString):
TDOMProcessingInstruction; override;
function CreateEntityReference(const name: DOMString): TDOMEntityReference; override;
property XMLVersion: DOMString read FXMLVersion write SetXMLVersion;
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 = (
dtCdata,
dtId,
dtIdRef,
dtIdRefs,
dtEntity,
dtEntities,
dtNmToken,
dtNmTokens,
dtNotation
);
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
FOwnerElement: TDOMElement;
FDataType: TAttrDataType;
function GetNodeValue: DOMString; override;
function GetNodeType: Integer; override;
function GetSpecified: Boolean;
function GetIsID: Boolean;
procedure SetNodeValue(const AValue: DOMString); override;
public
destructor Destroy; override;
function CloneNode({%H-}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 FOwnerElement;
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: TDOMAttr);
public
destructor Destroy; override;
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
function IsEmpty: Boolean; virtual;
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({%H-}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({%H-}deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
end;
// -------------------------------------------------------
// CDATASection
// -------------------------------------------------------
TDOMCDATASection = class(TDOMText)
protected
function GetNodeType: Integer; override;
function GetNodeName: DOMString; override;
public
function CloneNode({%H-}deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
end;
// -------------------------------------------------------
// DocumentType
// -------------------------------------------------------
TDOMDocumentType = class(TDOMNode)
protected
FName: DOMString;
FPublicID: DOMString;
FSystemID: DOMString;
FInternalSubset: DOMString;
FEntities, FNotations: TDOMNamedNodeMap;
function GetEntities: TDOMNamedNodeMap;
function GetNotations: TDOMNamedNodeMap;
function GetNodeType: Integer; override;
function GetNodeName: DOMString; override;
public
destructor Destroy; override;
property Name: DOMString read FName;
property Entities: TDOMNamedNodeMap read GetEntities;
property Notations: TDOMNamedNodeMap read GetNotations;
// Introduced in DOM Level 2:
property PublicID: DOMString read FPublicID;
property SystemID: DOMString read FSystemID;
property InternalSubset: DOMString read FInternalSubset;
end;
// -------------------------------------------------------
// Notation
// -------------------------------------------------------
TDOMNotation = class(TDOMNode)
protected
FName: DOMString;
FPublicID, FSystemID: DOMString;
function GetNodeType: Integer; override;
function GetNodeName: DOMString; override;
public
function CloneNode({%H-}deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
property PublicID: DOMString read FPublicID;
property SystemID: DOMString read FSystemID;
end;
// -------------------------------------------------------
// Entity
// -------------------------------------------------------
TDOMEntity = class(TDOMNode_WithChildren)
protected
FName: DOMString;
FPublicID, FSystemID, FNotationName: DOMString;
function GetNodeType: Integer; override;
function GetNodeName: DOMString; override;
public
function CloneNode(deep: Boolean; aCloneOwner: TDOMDocument): TDOMNode; override;
property PublicID: DOMString read FPublicID;
property SystemID: DOMString read FSystemID;
property NotationName: DOMString read FNotationName;
end;
// -------------------------------------------------------
// EntityReference
// -------------------------------------------------------
TDOMEntityReference = class(TDOMNode_WithChildren)
protected
FName: DOMString;
function GetNodeType: Integer; override;
function GetNodeName: DOMString; override;
public
function CloneNode({%H-}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({%H-}deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
property Target: DOMString read FTarget;
property Data: DOMString read FNodeValue write SetNodeValue;
end;
// Attribute declaration - Attr descendant which carries rudimentary type info
// must be severely improved while developing Level 3
TAttrDefault = (
adImplied,
adDefault,
adRequired,
adFixed
);
TDOMAttrDef = class(TDOMAttr)
protected
FExternallyDeclared: Boolean;
FDefault: TAttrDefault;
FTag: Cardinal;
FEnumeration: array of DOMString;
public
function AddEnumToken(Buf: DOMPChar; Len: Integer): Boolean;
function HasEnumToken(const aValue: DOMString): Boolean;
function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
property Default: TAttrDefault read FDefault write FDefault;
property ExternallyDeclared: Boolean read FExternallyDeclared write FExternallyDeclared;
property Tag: Cardinal read FTag write FTag;
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;
// URIs of predefined namespaces
const
stduri_xml: DOMString = 'http://www.w3.org/XML/1998/namespace';
stduri_xmlns: DOMString = 'http://www.w3.org/2000/xmlns/';
function StrToXMLValue(const s: string): string; // removes #0, encodes <>&'"
function XMLValueToStr(const s: string): string; // reverse of StrToXMLValue (except for invalid #0)
function EncodeLesserAndGreaterThan(const s: string): string;
// =======================================================
// =======================================================
implementation
function StrToXMLValue(const s: string): string;
function Convert(Dst: PChar; out NewLen: PtrUInt): boolean;
var
h: PChar;
l: Integer;
NewLength: Integer;
Src: PChar;
i: Integer;
begin
Result:=false;
NewLength:=0;
Src:=PChar(s);
repeat
case Src^ of
#0:
if Src-PChar(s)=length(s) then
break
else begin
h:=''; l:=0;
end;
'&': begin h:='&amp;'; l:=5; end;
'<': begin h:='&lt;'#0; l:=4; end;
'>': begin h:='&gt;'#0; l:=4; end;
'"': begin h:='&quot;'#0; l:=6; end;
'''': begin h:='&apos;'#0; l:=6; end;
else
if Dst<>nil then begin
Dst^:=Src^;
inc(Dst);
end else
inc(NewLength);
inc(Src);
continue;
end;
Result:=true;
if l>0 then begin
if Dst<>nil then begin
for i:=1 to l do begin
Dst^:=h^;
inc(Dst);
inc(h);
end;
end else
inc(NewLength,l);
end;
inc(Src);
until false;
NewLen:=NewLength;
end;
var
NewLen: PtrUInt;
begin
Result:=s;
if Result='' then exit;
if not Convert(nil,NewLen) then exit;
SetLength(Result,NewLen);
if NewLen=0 then exit;
Convert(PChar(Result),NewLen);
end;
function XMLValueToStr(const s: string): string;
// convert &amp &quot &apos &lt &gt
var
Src: PChar;
Dst: PChar;
begin
if Pos('&',s)<1 then exit(s);
SetLength(Result,length(s));
Src:=PChar(s);
Dst:=PChar(Result);
repeat
case Src^ of
#0:
if Src-PChar(s)=length(s) then
break
else
inc(Src);
'&':
begin
inc(Src);
case Src^ of
'a':
if (Src[1]='m') and (Src[2]='p') then begin
inc(Src,3);
if Src^=';' then inc(Src);
Dst^:='&';
inc(Dst);
continue;
end else if (Src[1]='p') and (Src[2]='o') and (Src[3]='s') then begin
inc(Src,4);
if Src^=';' then inc(Src);
Dst^:='''';
inc(Dst);
continue;
end;
'q':
if (Src[1]='u') and (Src[2]='o') and (Src[3]='t') then begin
inc(Src,4);
if Src^=';' then inc(Src);
Dst^:='"';
inc(Dst);
continue;
end;
'l':
if (Src[1]='t') then begin
inc(Src,2);
if Src^=';' then inc(Src);
Dst^:='<';
inc(Dst);
continue;
end;
'g':
if (Src[1]='t') then begin
inc(Src,2);
if Src^=';' then inc(Src);
Dst^:='>';
inc(Dst);
continue;
end;
end;
Dst^:='&';
inc(Dst);
end;
else
Dst^:=Src^;
inc(Src);
inc(Dst);
end;
until false;
SetLength(Result,Dst-PChar(Result));
end;
function EncodeLesserAndGreaterThan(const s: string): string;
function Convert(Dst: PChar; out NewLen: PtrUInt): boolean;
var
h: PChar;
l: Integer;
NewLength: Integer;
Src: PChar;
i: Integer;
begin
Result:=false;
NewLength:=0;
Src:=PChar(s);
repeat
case Src^ of
#0:
if Src-PChar(s)=length(s) then
break
else begin
h:=''; l:=0;
end;
'<': begin h:='&lt;'#0; l:=4; end;
'>': begin h:='&gt;'#0; l:=4; end;
else
if Dst<>nil then begin
Dst^:=Src^;
inc(Dst);
end else
inc(NewLength);
inc(Src);
continue;
end;
Result:=true;
if l>0 then begin
if Dst<>nil then begin
for i:=1 to l do begin
Dst^:=h^;
inc(Dst);
inc(h);
end;
end else
inc(NewLength,l);
end;
inc(Src);
until false;
NewLen:=NewLength;
end;
var
NewLen: PtrUInt;
begin
Result:=s;
if Result='' then exit;
if not Convert(nil,NewLen) then exit;
SetLength(Result,NewLen);
if NewLen=0 then exit;
Convert(PChar(Result),NewLen);
end;
{ a namespace-enabled NamedNodeMap }
type
TAttributeMap = class(TDOMNamedNodeMap)
private
function FindNS(nsIndex: Integer; const aLocalName: DOMString;
out SortedIndex: LongWord): Boolean;
function InternalRemoveNS(const nsURI, aLocalName: DOMString): TDOMNode;
public
function getNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode; override;
function setNamedItemNS(arg: TDOMNode): TDOMNode; override;
function removeNamedItemNS(const namespaceURI,localName: DOMString): TDOMNode; override;
end;
{ TDOMNodeAllChildEnumerator }
constructor TDOMNodeAllChildEnumerator.Create(Node: TDOMNode);
begin
FNode:=Node;
FEnd:=Node.GetNextNodeSkipChildren;
end;
function TDOMNodeAllChildEnumerator.MoveNext: boolean;
begin
if FCurrent=nil then
FCurrent:=FNode.GetNextNode
else
FCurrent:=FCurrent.GetNextNode;
Result:=FCurrent<>FEnd;
end;
function TDOMNodeAllChildEnumerator.GetEnumerator: TDOMNodeAllChildEnumerator;
begin
Result:=Self;
end;
{ TDOMNodeEnumerator }
constructor TDOMNodeEnumerator.Create(Node: TDOMNode);
begin
FNode:=Node;
end;
function TDOMNodeEnumerator.MoveNext: boolean;
begin
if FCurrent=nil then
FCurrent:=FNode.FirstChild
else
FCurrent:=FCurrent.NextSibling;
Result:=FCurrent<>nil;
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;
procedure TDOMNode.SetNodeValue(const AValue: DOMString);
begin
// do nothing
end;
function TDOMNode.GetChildNodes: TDOMNodeList;
begin
Result := FOwnerDocument.GetChildNodeList(Self);
end;
function TDOMNode.GetChildCount: SizeInt;
begin
Result:=0;
end;
function TDOMNode.GetEnumerator: TDOMNodeEnumerator;
begin
Result:=TDOMNodeEnumerator.Create(Self);
end;
function TDOMNode.GetEnumeratorAllChildren: TDOMNodeAllChildEnumerator;
begin
Result:=TDOMNodeAllChildEnumerator.Create(Self);
end;
function TDOMNode.GetNextNode: TDOMNode;
begin
Result:=FirstChild;
if Result=nil then
Result:=GetNextNodeSkipChildren;
end;
function TDOMNode.GetNextNodeSkipChildren: TDOMNode;
var
Node: TDOMNode;
begin
Result:=Self;
repeat
Node:=Result.NextSibling;
if Node<>nil then exit(Node);
Result:=Result.ParentNode;
until Result=nil;
Result:=nil;
end;
function TDOMNode.GetPreviousNode: TDOMNode;
var
Node: TDOMNode;
begin
Result:=PreviousSibling;
if Result=nil then
exit(ParentNode);
Node:=Result.GetLastLeaf;
if Node<>nil then
Result:=Node;
end;
function TDOMNode.GetLastLeaf: TDOMNode;
var
Node: TDOMNode;
begin
Result:=LastChild;
if Result=nil then exit;
repeat
Node:=Result.LastChild;
if Node=nil then exit;
Result:=Node;
until false;
end;
function TDOMNode.GetLevel: SizeInt;
var
Node: TDOMNode;
begin
Result:=0;
Node:=ParentNode;
while Node<>nil do begin
inc(Result);
Node:=Node.ParentNode;
end;
end;
function TDOMNode.GetFirstChild: TDOMNode;
begin
Result := nil;
end;
function TDOMNode.GetLastChild: TDOMNode;
begin
Result := nil;
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 TDOMNode.GetBaseURI: DOMString;
begin
case NodeType of
// !! Incomplete !!
DOCUMENT_NODE:
result := TDOMDocument(Self).FDocumentURI;
PROCESSING_INSTRUCTION_NODE:
if Assigned(ParentNode) then
result := ParentNode.GetBaseURI
else
result := OwnerDocument.DocumentURI;
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
Result := FLastChild;
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
FLastChild.FNextSibling := NewChild;
NewChild.FPreviousSibling := FLastChild;
end else
FFirstChild := NewChild;
FLastChild := NewChild;
end
else // insert before RefChild
begin
if RefChild = FFirstChild then
FFirstChild := NewChild
else
begin
RefChild.FPreviousSibling.FNextSibling := NewChild;
NewChild.FPreviousSibling := RefChild.FPreviousSibling;
end;
RefChild.FPreviousSibling := NewChild;
end;
NewChild.FParentNode := Self;
end;
function TDOMNode_WithChildren.ReplaceChild(NewChild, OldChild: TDOMNode):
TDOMNode;
begin
InsertBefore(NewChild, OldChild);
if Assigned(OldChild) then
RemoveChild(OldChild);
Result := OldChild;
end;
function TDOMNode_WithChildren.DetachChild(OldChild: TDOMNode): TDOMNode;
begin
Changing;
if OldChild.ParentNode <> Self then
raise EDOMNotFound.Create('NodeWC.RemoveChild');
Inc(FOwnerDocument.FRevision); // invalidate nodelists
if OldChild = FFirstChild then
FFirstChild := FFirstChild.FNextSibling
else
OldChild.FPreviousSibling.FNextSibling := OldChild.FNextSibling;
if OldChild = FLastChild then
FLastChild := FLastChild.FPreviousSibling
else
OldChild.FNextSibling.FPreviousSibling := OldChild.FPreviousSibling;
// 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);
begin
if Assigned(FFirstChild) then
begin
FLastChild.FNextSibling := NewChild;
NewChild.FPreviousSibling := FLastChild;
end else
FFirstChild := NewChild;
FLastChild := NewChild;
NewChild.FParentNode := Self;
end;
function TDOMNode_WithChildren.HasChildNodes: Boolean;
begin
Result := Assigned(FFirstChild);
end;
function TDOMNode_WithChildren.GetChildCount: SizeInt;
var
Node: TDOMNode;
begin
if FFirstChild=nil then exit(0);
if FChildNodes<>nil then
Result:=FChildNodes.Count
else begin
Result:=0;
Node:=FFirstChild;
while Node<>nil do begin
inc(Result);
Node:=Node.NextSibling;
end;
end;
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;
FLastChild := 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(DOMChar)))) then
Result := frTrue;
end;
end
else if (not UseFilter or (TagName = Filter)) then
Result := frTrue;
end;
end;
// -------------------------------------------------------
// NamedNodeMap
// -------------------------------------------------------
constructor TDOMNamedNodeMap.Create(AOwner: TDOMNode; ANodeType: Integer);
begin
inherited Create;
FOwner := AOwner;
FNodeType := ANodeType;
end;
destructor TDOMNamedNodeMap.Destroy;
var
I: Integer;
begin
FSortedList.Free;
if FPosList<>nil then begin
for I := FPosList.Count-1 downto 0 do
TDOMNode(FPosList[I]).Free;
FPosList.Free;
end;
inherited Destroy;
end;
function TDOMNamedNodeMap.GetSortedItem(index: LongWord): TDOMNode;
begin
Result := TDOMNode(FSortedList.List^[index]);
end;
function TDOMNamedNodeMap.GetPosItem(index: LongWord): TDOMNode;
begin
Result := TDOMNode(FPosList.List^[index]);
end;
function TDOMNamedNodeMap.GetLength: LongWord;
begin
if FPosList<>nil then
Result := FPosList.Count
else
Result := 0;
end;
function TDOMNamedNodeMap.FindSorted(const name: DOMString; out Index: LongWord): Boolean;
var
L, H, I, C: Integer;
begin
Result := False;
L := 0;
if FPosList<>nil then begin
H := FSortedList.Count - 1;
while L <= H do
begin
I := (L + H) shr 1;
C := TDOMNode(FSortedList.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;
end;
Index := L;
end;
function TDOMNamedNodeMap.GetNamedItem(const name: DOMString): TDOMNode;
var
i: Cardinal;
begin
if FindSorted(name, i) then
Result := TDOMNode(FSortedList.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;
var
AttrOwner: TDOMNode;
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
else if arg.NodeType <> FNodeType then
Result := HIERARCHY_REQUEST_ERR
else if (FNodeType = ATTRIBUTE_NODE) then
begin
AttrOwner := TDOMAttr(arg).ownerElement;
if Assigned(AttrOwner) and (AttrOwner <> FOwner) then
Result := INUSE_ATTRIBUTE_ERR;
end;
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');
if FNodeType = ATTRIBUTE_NODE then
begin
TDOMAttr(arg).FOwnerElement := TDOMElement(FOwner);
Exists := FindSorted(TDOMAttr(arg).Name, i); // optimization
end
else
Exists := FindSorted(arg.NodeName, i);
if Exists then
begin
Result := TDOMNode(FSortedList.List^[i]);
if (Result <> arg) then
begin
if (FNodeType = ATTRIBUTE_NODE) then
TDOMAttr(Result).FOwnerElement := nil;
FSortedList.List^[i] := arg;
i:=FPosList.IndexOf(Result);
FPosList.List^[i] := arg;
end;
exit;
end;
if FSortedList=nil then FSortedList:=TFPList.Create;
FSortedList.Insert(i, arg);
if FPosList=nil then FPosList:=TFPList.Create;
FPosList.Add(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.DeleteSorted(index: LongWord): TDOMNode;
begin
Result := TDOMNode(FSortedList.List^[index]);
FSortedList.Delete(index);
FPosList.Remove(Result);
if FNodeType = ATTRIBUTE_NODE then
TDOMAttr(Result).FOwnerElement := nil;
end;
procedure TDOMNamedNodeMap.RestoreDefault(const name: DOMString);
var
eldef: TDOMElement;
attrdef: TDOMAttr;
begin
if FNodeType = ATTRIBUTE_NODE then
begin
if not Assigned(TDOMElement(FOwner).FNSI.QName) then // safeguard
Exit;
eldef := TDOMElement(TDOMElement(FOwner).FNSI.QName^.Data);
if Assigned(eldef) then
begin
// TODO: can be avoided by linking attributes directly to their defs
attrdef := eldef.GetAttributeNode(name);
if Assigned(attrdef) and (TDOMAttrDef(attrdef).FDefault in [adDefault, adFixed]) then
TDOMElement(FOwner).RestoreDefaultAttr(attrdef);
end;
end;
end;
function TDOMNamedNodeMap.InternalRemove(const name: DOMString): TDOMNode;
var
i: Cardinal;
begin
Result := nil;
if FindSorted(name, i) then
begin
Result := DeleteSorted(I);
RestoreDefault(name);
end;
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 }
// 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 SortedIndex: LongWord): Boolean;
var
I: Integer;
P: DOMPChar;
begin
if FSortedList<>nil then begin
for I := 0 to FSortedList.Count-1 do
begin
with TDOMAttr(FSortedList.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
SortedIndex := I;
Result := True;
Exit;
end;
end;
end;
end;
end;
SortedIndex := High(SortedIndex)-1;
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
begin
Result := DeleteSorted(I);
RestoreDefault(TDOMAttr(Result).FNSI.QName^.Key);
end;
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(FSortedList.List^[i])
else
Result := nil;
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(FSortedList.List^[i]);
FSortedList.Delete(i);
FPosList.Remove(Result);
end;
// Do a non-namespace search in order to keep the list sorted on nodeName
Exists := FindSorted(FNSI.QName^.Key, i);
if Exists and (Result = nil) then // case when arg has no namespace
begin
Result := TDOMNode(FSortedList.List^[i]);
FSortedList.List^[i] := arg;
i:=FPosList.IndexOf(Result);
FPosList.List^[i] := arg;
end
else begin
if FSortedList=nil then FSortedList:=TFPList.Create;
FSortedList.Insert(i, arg);
if FPosList=nil then FPosList:=TFPList.Create;
FPosList.Add(arg);
end;
end;
if Assigned(Result) then
TDOMAttr(Result).FOwnerElement := nil;
TDOMAttr(arg).FOwnerElement := TDOMElement(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;
// -------------------------------------------------------
// DOMImplementation
// -------------------------------------------------------
{ if nsIdx = -1, checks only the name. Otherwise additionally checks if the prefix is
valid for standard namespace specified by nsIdx.
Non-negative return value is Pos(':', QName), negative is DOM error code. }
function CheckQName(const QName: DOMString; nsIdx: Integer; Xml11: Boolean): Integer;
var
I, L: Integer;
begin
if not IsXmlName(QName, Xml11) then
begin
Result := -INVALID_CHARACTER_ERR;
Exit;
end;
L := Length(QName);
Result := Pos(DOMChar(':'), 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, Xml11)) then
begin
Result := -NAMESPACE_ERR;
Exit;
end;
end;
if nsIdx < 0 then Exit;
// QName contains prefix, but no namespace
if ((nsIdx = 0) and (Result > 0)) or
// Bad usage of 'http://www.w3.org/2000/xmlns/'
((((L = 5) or (Result = 6)) and (Pos(DOMString('xmlns'), QName) = 1)) <> (nsIdx = 2)) or
// Bad usage of 'http://www.w3.org/XML/1998/namespace'
((Result = 4) and (Pos(DOMString('xml'), QName) = 1) and (nsIdx <> 1)) then
Result := -NAMESPACE_ERR;
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;
begin
res := CheckQName(QualifiedName, -1, False);
if res < 0 then
raise EDOMError.Create(-res, 'Implementation.CreateDocumentType');
Result := TDOMDocumentType.Create(nil);
Result.FName := QualifiedName;
// DOM does not restrict PublicID without SystemID (unlike XML spec)
Result.FPublicID := PublicID;
Result.FSystemID := SystemID;
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 := (TDOMAttr.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);
FNodeLists := THashTable.Create(32, True);
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.Alloc(AClass: TDOMNodeClass): TDOMNode;
var
pp: TNodePool;
size: Integer;
begin
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;
function TDOMDocument.AddID(Attr: TDOMAttr): Boolean;
var
ID: DOMString;
Exists: Boolean;
p: PHashItem;
begin
if FIDList = nil then
FIDList := THashTable.Create(256, False);
ID := Attr.Value;
p := FIDList.FindOrAdd(DOMPChar(ID), Length(ID), Exists);
Result := not Exists;
if Result then
p^.Data := Attr.OwnerElement;
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 := 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, FXML11) 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, FXML11) 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.CreateAttributeDef(Buf: DOMPChar; Length: Integer): TDOMAttrDef;
begin
// not using custom allocation here
Result := TDOMAttrDef.Create(Self);
Result.FNSI.QName := FNames.FindOrAdd(Buf, Length);
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
L := (sizeof(Pointer) div sizeof(DOMChar)) + Length(aLocalName);
if UseNS then
Inc(L, Length(nsURI)+1);
GetMem(Key, L*sizeof(DOMChar));
try
// compose the key for hashing
P := Key;
PPointer(P)^ := aNode;
Inc(PPointer(P));
Move(DOMPChar(aLocalName)^, P^, Length(aLocalName)*sizeof(DOMChar));
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(DOMChar));
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) then
FNodeLists.RemoveData(aList);
end;
function TDOMDocument.CreateAttributeNS(const nsURI,
QualifiedName: DOMString): TDOMAttr;
var
idx, PrefIdx: Integer;
begin
idx := IndexOfNS(nsURI, True);
PrefIdx := CheckQName(QualifiedName, idx, FXml11);
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(idx);
Result.FNSI.PrefixLen := Word(PrefIdx);
Include(Result.FFlags, nfLevel2);
Include(Result.FFlags, nfSpecified);
end;
function TDOMDocument.CreateElementNS(const nsURI,
QualifiedName: DOMString): TDOMElement;
var
idx, PrefIdx: Integer;
begin
idx := IndexOfNS(nsURI, True);
PrefIdx := CheckQName(QualifiedName, idx, FXml11);
if PrefIdx < 0 then
raise EDOMError.Create(-PrefIdx, 'Document.CreateElementNS');
TDOMNode(Result) := Alloc(TDOMElement);
Result.Create(Self);
Result.FNSI.QName := FNames.FindOrAdd(DOMPChar(QualifiedName), Length(QualifiedName));
Result.FNSI.NSIndex := Word(idx);
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;
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, FXML11) 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, FXML11) 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
FXMLVersion := aValue;
FXML11 := (aValue = '1.1');
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, FOwnerDocument.FXml11) then
raise EDOMError.Create(INVALID_CHARACTER_ERR, 'Node.SetPrefix');
if (Pos(DOMChar(':'), Value) > 0) or not (nfLevel2 in FFlags) 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;
destructor TDOMAttr.Destroy;
begin
if Assigned(FOwnerElement) and not (nfDestroying in FOwnerElement.FFlags) then
// TODO: This may raise NOT_FOUND_ERR in case something's really wrong
FOwnerElement.RemoveAttributeNode(Self);
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;
// -------------------------------------------------------
// 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);
FreeAndNil(FAttributes);
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;
function TDOMElement.IsEmpty: boolean;
begin
Result:=(FAttributes=nil) or (FAttributes.Length=0);
end;
procedure TDOMElement.AttachDefaultAttrs;
var
eldef: TDOMElement;
attrdef: TDOMAttrDef;
I: Integer;
begin
if not Assigned(FNSI.QName) then // safeguard
Exit;
eldef := TDOMElement(FNSI.QName^.Data);
if Assigned(eldef) and Assigned(eldef.FAttributes) then
begin
for I := 0 to eldef.FAttributes.Length-1 do
begin
attrdef := TDOMAttrDef(eldef.FAttributes[I]);
if attrdef.FDefault 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;
procedure TDOMElement.RestoreDefaultAttr(AttrDef: TDOMAttr);
var
Attr: TDOMAttr;
ColonPos: Integer;
AttrName, nsuri: DOMString;
begin
Attr := TDOMAttr(AttrDef.CloneNode(True));
AttrName := Attr.Name;
ColonPos := Pos(DOMChar(':'), AttrName);
if Pos(DOMString('xmlns'), AttrName) = 1 then
begin
if (Length(AttrName) = 5) or (ColonPos = 6) then
Attr.SetNSI(stduri_xmlns, ColonPos);
end
else if ColonPos > 0 then
begin
if (ColonPos = 4) and (Pos(DOMString('xml'), AttrName) = 1) then
Attr.SetNSI(stduri_xml, 4)
else
begin
nsuri := LookupNamespaceURI(Copy(AttrName, 1, ColonPos-1));
// TODO: what if prefix isn't defined?
Attr.SetNSI(nsuri, ColonPos);
end
end;
// 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, ATTRIBUTE_NODE);
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.FindSorted(name, I) then
Attr := Attributes.SortedItem[I] as TDOMAttr
else
begin
Attr := FOwnerDocument.CreateAttribute(name);
Attr.FOwnerElement := Self;
if FAttributes.FSortedList=nil then FAttributes.FSortedList:=TFPList.Create;
FAttributes.FSortedList.Insert(I, Attr);
if FAttributes.FPosList=nil then FAttributes.FPosList:=TFPList.Create;
FAttributes.FPosList.Add(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;
begin
Changing;
idx := FOwnerDocument.IndexOfNS(nsURI, True);
prefIdx := CheckQName(qualifiedName, idx, FOwnerDocument.FXml11);
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.FPosList.Remove(FAttributes.FSortedList.List^[i]);
FAttributes.FSortedList.Delete(I);
end
else
begin
TDOMNode(Attr) := FOwnerDocument.Alloc(TDOMAttr);
Attr.Create(FOwnerDocument);
Attr.FOwnerElement := Self;
Attr.FNSI.NSIndex := Word(idx);
Include(Attr.FFlags, nfLevel2);
end;
// keep list sorted by DOM Level 1 name
FAttributes.FindSorted(qualifiedName, I);
if FAttributes.FSortedList=nil then FAttributes.FSortedList:=TFPList.Create;
FAttributes.FSortedList.Insert(I, Attr);
if FAttributes.FPosList=nil then FAttributes.FPosList:=TFPList.Create;
FAttributes.FPosList.Add(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;
begin
Changing;
Result:=OldAttr;
if Assigned(FAttributes) and (FAttributes.FSortedList<>nil)
and (FAttributes.FSortedList.Remove(OldAttr) > -1)
then begin
FAttributes.FPosList.Remove(OldAttr);
if Assigned(OldAttr.FNSI.QName) then // safeguard
FAttributes.RestoreDefault(OldAttr.FNSI.QName^.Key);
Result.FOwnerElement := nil;
end
else
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;
begin
Changing;
if offset > Length then
raise EDOMIndexSize.Create('Text.SplitText');
Result := TDOMText.Create(FOwnerDocument);
Result.FNodeValue := Copy(FNodeValue, offset + 1, Length);
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 := FName;
end;
destructor TDOMDocumentType.Destroy;
begin
FEntities.Free;
FNotations.Free;
inherited Destroy;
end;
function TDOMDocumentType.GetEntities: TDOMNamedNodeMap;
begin
if FEntities = nil then
FEntities := TDOMNamedNodeMap.Create(Self, ENTITY_NODE);
Result := FEntities;
end;
function TDOMDocumentType.GetNotations: TDOMNamedNodeMap;
begin
if FNotations = nil then
FNotations := TDOMNamedNodeMap.Create(Self, NOTATION_NODE);
Result := FNotations;
end;
// -------------------------------------------------------
// Notation
// -------------------------------------------------------
function TDOMNotation.GetNodeType: Integer;
begin
Result := NOTATION_NODE;
end;
function TDOMNotation.GetNodeName: DOMString;
begin
Result := FName;
end;
function TDOMNotation.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
begin
Result := ACloneOwner.Alloc(TDOMNotation);
TDOMNotation(Result).Create(ACloneOwner);
TDOMNotation(Result).FName := FName;
TDOMNotation(Result).FPublicID := PublicID;
TDOMNotation(Result).FSystemID := SystemID;
// notation cannot have children, ignore Deep
end;
// -------------------------------------------------------
// Entity
// -------------------------------------------------------
function TDOMEntity.GetNodeType: Integer;
begin
Result := ENTITY_NODE;
end;
function TDOMEntity.GetNodeName: DOMString;
begin
Result := FName;
end;
function TDOMEntity.CloneNode(deep: Boolean; aCloneOwner: TDOMDocument): TDOMNode;
begin
Result := aCloneOwner.Alloc(TDOMEntity);
TDOMEntity(Result).Create(aCloneOwner);
TDOMEntity(Result).FName := FName;
TDOMEntity(Result).FSystemID := FSystemID;
TDOMEntity(Result).FPublicID := FPublicID;
TDOMEntity(Result).FNotationName := FNotationName;
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;
{ TDOMAttrDef }
function TDOMAttrDef.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
begin
Result := inherited CloneNode(deep, ACloneOwner);
Exclude(Result.FFlags, nfSpecified);
end;
function TDOMAttrDef.AddEnumToken(Buf: DOMPChar; Len: Integer): Boolean;
var
I, L: Integer;
begin
// TODO: this implementaion is the slowest possible...
Result := False;
L := Length(FEnumeration);
for I := 0 to L-1 do
begin
if CompareDomStrings(Buf, DOMPChar(FEnumeration[I]), Len, Length(FEnumeration[I])) = 0 then
Exit;
end;
SetLength(FEnumeration, L+1);
SetString(FEnumeration[L], Buf, Len);
Result := True;
end;
function TDOMAttrDef.HasEnumToken(const aValue: DOMString): Boolean;
var
I: Integer;
begin
Result := True;
if Length(FEnumeration) = 0 then
Exit;
for I := 0 to Length(FEnumeration)-1 do
begin
if FEnumeration[I] = aValue then
Exit;
end;
Result := False;
end;
{ 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.
Reference in New Issue View Git Blame Copy Permalink