1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232 |
- {
- This file is part of the Free Component Library
- Implementation of DOM interfaces
- Copyright (c) 1999-2000 by Sebastian Guenther, [email protected]
- Modified in 2006 by Sergei Gorelkin, [email protected]
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- {
- This unit provides classes which implement the interfaces defined in the
- DOM (Document Object Model) specification.
- The current state is:
- DOM Level 1 - Almost completely implemented
- DOM Level 2 - Partially implemented
- Specification used for this implementation:
- "Document Object Model (DOM) Level 2 Specification Version 1.0
- W3C Recommendation 11 November, 2000"
- http://www.w3.org/TR/2000/REC-DOM-Level-2-Core-20001113
- }
- unit DOM;
- {$ifdef fpc}
- {$MODE objfpc}{$H+}
- {$endif}
- interface
- uses
- SysUtils, Classes, AVL_Tree, 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;
- TDOMAttr = class;
- TDOMElement = class;
- TDOMText = class;
- TDOMComment = class;
- TDOMCDATASection = class;
- TDOMDocumentType = class;
- TDOMEntityReference = class;
- TDOMProcessingInstruction = class;
- TDOMAttrDef = class;
- PNodePool = ^TNodePool;
- TNodePool = class;
- // -------------------------------------------------------
- // DOMString
- // -------------------------------------------------------
- TSetOfChar = set of Char;
- DOMString = WideString;
- DOMPChar = PWideChar;
- 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;
- 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 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 Value: DOMString); virtual;
- function GetOwnerDocument: TDOMDocument; virtual;
- procedure SetReadOnly(Value: Boolean);
- procedure Changing;
- public
- constructor Create(AOwner: TDOMDocument);
- destructor Destroy; override;
- procedure FreeInstance; override;
- function GetChildNodes: TDOMNodeList;
- property NodeName: DOMString read GetNodeName;
- property NodeValue: DOMString read GetNodeValue write SetNodeValue;
- property NodeType: Integer read GetNodeType;
- property ParentNode: TDOMNode read 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 InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; virtual;
- function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; virtual;
- function DetachChild(OldChild: TDOMNode): TDOMNode; virtual;
- function RemoveChild(OldChild: TDOMNode): TDOMNode;
- function AppendChild(NewChild: TDOMNode): TDOMNode;
- function HasChildNodes: Boolean; virtual;
- function CloneNode(deep: Boolean): TDOMNode; overload;
- // 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 LookupNamespaceURI(const APrefix: DOMString): DOMString;
- // Extensions to DOM interface:
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; virtual;
- function FindNode(const ANodeName: DOMString): TDOMNode; virtual;
- function CompareName(const name: DOMString): Integer; virtual;
- 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 = class(TDOMNode)
- protected
- FFirstChild, FLastChild: TDOMNode;
- FChildNodeTree: TAVLTree;
- FChildNodes: TDOMNodeList;
- function GetFirstChild: TDOMNode; override;
- function GetLastChild: TDOMNode; override;
- procedure CloneChildren(ACopy: TDOMNode; ACloneOwner: TDOMDocument);
- procedure AddToChildNodeTree(NewNode: TDOMNode);
- procedure RemoveFromChildNodeTree(OldNode: TDOMNode);
- procedure FreeChildren;
- function GetTextContent: DOMString; override;
- procedure SetTextContent(const AValue: DOMString); override;
- public
- destructor Destroy; override;
- function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; override;
- function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; override;
- function DetachChild(OldChild: TDOMNode): TDOMNode; override;
- function HasChildNodes: Boolean; override;
- function FindNode(const ANodeName: DOMString): TDOMNode; override;
- end;
- // -------------------------------------------------------
- // NodeList
- // -------------------------------------------------------
- TFilterResult = (frFalse, frNorecurseFalse, frTrue, frNorecurseTrue);
- TDOMNodeList = class(TObject)
- protected
- FNode: TDOMNode;
- FRevision: Integer;
- FList: TFPList;
- function GetCount: LongWord;
- function GetItem(index: LongWord): TDOMNode;
- function NodeFilter(aNode: TDOMNode): TFilterResult; virtual;
- // now deprecated in favor of NodeFilter
- procedure BuildList; virtual;
- public
- constructor Create(ANode: TDOMNode);
- destructor Destroy; override;
- property Item[index: LongWord]: TDOMNode read GetItem; default;
- property Count: LongWord read GetCount;
- property Length: LongWord read GetCount;
- end;
- { an extension to DOM interface, used to build recursive lists of elements }
- TDOMElementList = class(TDOMNodeList)
- protected
- filter: DOMString;
- FNSIndexFilter: Integer;
- localNameFilter: DOMString;
- FMatchNS: Boolean;
- FMatchAnyNS: Boolean;
- UseFilter: Boolean;
- function NodeFilter(aNode: TDOMNode): TFilterResult; override;
- public
- constructor Create(ANode: TDOMNode; const AFilter: DOMString); overload;
- constructor Create(ANode: TDOMNode; const nsURI, localName: DOMString); overload;
- end;
- // -------------------------------------------------------
- // NamedNodeMap
- // -------------------------------------------------------
- TDOMNamedNodeMap = class(TObject)
- protected
- FOwner: TDOMNode;
- FNodeType: Integer;
- FList: TFPList;
- function GetItem(index: LongWord): TDOMNode;
- function GetLength: LongWord;
- function Find(const name: DOMString; out Index: LongWord): Boolean;
- function Delete(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 namespaceURI, localName: DOMString): TDOMNode; virtual;
- function setNamedItemNS(arg: TDOMNode): TDOMNode; virtual;
- function removeNamedItemNS(const namespaceURI,localName: DOMString): TDOMNode; virtual;
- property Item[index: LongWord]: TDOMNode read GetItem; default;
- property Length: LongWord read GetLength;
- end;
- // -------------------------------------------------------
- // CharacterData
- // -------------------------------------------------------
- TDOMCharacterData = class(TDOMNode)
- private
- FNodeValue: DOMString;
- protected
- function GetLength: LongWord;
- function GetNodeValue: DOMString; override;
- procedure SetNodeValue(const AValue: DOMString); override;
- public
- property Data: DOMString read FNodeValue write SetNodeValue;
- property Length: LongWord read GetLength;
- function SubstringData(offset, count: LongWord): DOMString;
- procedure AppendData(const arg: DOMString);
- procedure InsertData(offset: LongWord; const arg: DOMString);
- procedure DeleteData(offset, count: LongWord);
- procedure ReplaceData(offset, count: LongWord; const arg: DOMString);
- end;
- // -------------------------------------------------------
- // DOMImplementation
- // -------------------------------------------------------
- TDOMImplementation = class
- public
- function HasFeature(const feature, version: DOMString): Boolean;
- // Introduced in DOM Level 2:
- function CreateDocumentType(const QualifiedName, PublicID,
- SystemID: DOMString): TDOMDocumentType;
- function CreateDocument(const NamespaceURI, QualifiedName: DOMString;
- doctype: TDOMDocumentType): TDOMDocument;
- end;
- // -------------------------------------------------------
- // DocumentFragment
- // -------------------------------------------------------
- TDOMDocumentFragment = class(TDOMNode_WithChildren)
- protected
- function GetNodeType: Integer; override;
- function GetNodeName: DOMString; override;
- public
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- end;
- // -------------------------------------------------------
- // Document
- // -------------------------------------------------------
- // TODO: to be replaced by more suitable container
- TNamespaces = array of DOMString;
- TDOMDocument = class(TDOMNode_WithChildren)
- protected
- FIDList: THashTable;
- FRevision: Integer;
- FXML11: Boolean;
- FImplementation: TDOMImplementation;
- FNamespaces: TNamespaces;
- FNames: THashTable;
- FEmptyNode: TDOMElement;
- FNodeLists: THashTable;
- FMaxPoolSize: Integer;
- FPools: PNodePool;
- 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 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;
- property DocType: TDOMDocumentType read GetDocType;
- property Impl: TDOMImplementation read FImplementation;
- property DocumentElement: TDOMElement read GetDocumentElement;
- function CreateElement(const tagName: DOMString): TDOMElement; virtual;
- function CreateElementBuf(Buf: DOMPChar; Length: Integer): TDOMElement;
- function CreateDocumentFragment: TDOMDocumentFragment;
- function CreateTextNode(const data: DOMString): TDOMText;
- function CreateTextNodeBuf(Buf: DOMPChar; Length: Integer; IgnWS: Boolean): TDOMText;
- function CreateComment(const data: DOMString): TDOMComment;
- function CreateCommentBuf(Buf: DOMPChar; Length: Integer): TDOMComment;
- function CreateCDATASection(const data: DOMString): TDOMCDATASection;
- virtual;
- function CreateProcessingInstruction(const target, data: DOMString):
- TDOMProcessingInstruction; virtual;
- function CreateAttribute(const name: DOMString): TDOMAttr;
- function CreateAttributeBuf(Buf: DOMPChar; Length: Integer): TDOMAttr;
- function CreateAttributeDef(Buf: DOMPChar; Length: Integer): TDOMAttrDef;
- function CreateEntityReference(const name: DOMString): TDOMEntityReference;
- virtual;
- function GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
- // DOM level 2 methods
- function ImportNode(ImportedNode: TDOMNode; Deep: Boolean): TDOMNode;
- function CreateElementNS(const nsURI, QualifiedName: DOMString): TDOMElement;
- 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(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;
- procedure RestoreDefaultAttr(AttrDef: TDOMAttr);
- public
- destructor Destroy; override;
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- procedure Normalize; override;
- property TagName: DOMString read GetNodeName;
- function GetAttribute(const name: DOMString): DOMString;
- procedure SetAttribute(const name, value: DOMString);
- procedure RemoveAttribute(const name: DOMString);
- function GetAttributeNode(const name: DOMString): TDOMAttr;
- function SetAttributeNode(NewAttr: TDOMAttr): TDOMAttr;
- function RemoveAttributeNode(OldAttr: TDOMAttr): TDOMAttr;
- function GetElementsByTagName(const name: DOMString): TDOMNodeList;
- // Introduced in DOM Level 2:
- function GetAttributeNS(const nsURI, aLocalName: DOMString): DOMString;
- procedure SetAttributeNS(const nsURI, qualifiedName, value: DOMString);
- procedure RemoveAttributeNS(const nsURI, aLocalName: DOMString);
- function GetAttributeNodeNS(const nsURI, aLocalName: DOMString): TDOMAttr;
- function SetAttributeNodeNS(newAttr: TDOMAttr): TDOMAttr;
- function GetElementsByTagNameNS(const nsURI, aLocalName: DOMString): TDOMNodeList;
- function hasAttribute(const name: DOMString): Boolean;
- function hasAttributeNS(const nsURI, aLocalName: DOMString): Boolean;
- function HasAttributes: Boolean; override;
- // extension
- property AttribStrings[const Name: DOMString]: DOMString
- read GetAttribute write SetAttribute; default;
- end;
- // -------------------------------------------------------
- // Text
- // -------------------------------------------------------
- TDOMText = class(TDOMCharacterData)
- protected
- function GetNodeType: Integer; override;
- function GetNodeName: DOMString; override;
- procedure SetNodeValue(const aValue: DOMString); override;
- public
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- function SplitText(offset: LongWord): TDOMText;
- function IsElementContentWhitespace: Boolean;
- end;
- // -------------------------------------------------------
- // Comment
- // -------------------------------------------------------
- TDOMComment = class(TDOMCharacterData)
- protected
- function GetNodeType: Integer; override;
- function GetNodeName: DOMString; override;
- public
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- end;
- // -------------------------------------------------------
- // CDATASection
- // -------------------------------------------------------
- TDOMCDATASection = class(TDOMText)
- protected
- function GetNodeType: Integer; override;
- function GetNodeName: DOMString; override;
- public
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- end;
- // -------------------------------------------------------
- // DocumentType
- // -------------------------------------------------------
- TDOMDocumentType = class(TDOMNode)
- protected
- 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(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(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- end;
- // -------------------------------------------------------
- // ProcessingInstruction
- // -------------------------------------------------------
- TDOMProcessingInstruction = class(TDOMNode)
- private
- FTarget: DOMString;
- FNodeValue: DOMString;
- protected
- function GetNodeType: Integer; override;
- function GetNodeName: DOMString; override;
- function GetNodeValue: DOMString; override;
- procedure SetNodeValue(const AValue: DOMString); override;
- public
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- property Target: DOMString read FTarget;
- property Data: DOMString read FNodeValue write SetNodeValue;
- end;
- // 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/';
- // =======================================================
- // =======================================================
- implementation
- { a namespace-enabled NamedNodeMap }
- type
- TAttributeMap = class(TDOMNamedNodeMap)
- private
- function FindNS(nsIndex: Integer; const aLocalName: DOMString;
- out Index: LongWord): Boolean;
- function InternalRemoveNS(const nsURI, aLocalName: DOMString): TDOMNode;
- public
- function getNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode; override;
- function setNamedItemNS(arg: TDOMNode): TDOMNode; override;
- function removeNamedItemNS(const namespaceURI,localName: DOMString): TDOMNode; override;
- end;
- // -------------------------------------------------------
- // DOM Exception
- // -------------------------------------------------------
- constructor EDOMError.Create(ACode: Integer; const ASituation: String);
- begin
- Code := ACode;
- inherited Create(Self.ClassName + ' in ' + ASituation);
- end;
- constructor EDOMIndexSize.Create(const ASituation: String); // 1
- begin
- inherited Create(INDEX_SIZE_ERR, ASituation);
- end;
- constructor EDOMHierarchyRequest.Create(const ASituation: String); // 3
- begin
- inherited Create(HIERARCHY_REQUEST_ERR, ASituation);
- end;
- constructor EDOMWrongDocument.Create(const ASituation: String); // 4
- begin
- inherited Create(WRONG_DOCUMENT_ERR, ASituation);
- end;
- constructor EDOMNotFound.Create(const ASituation: String); // 8
- begin
- inherited Create(NOT_FOUND_ERR, ASituation);
- end;
- constructor EDOMNotSupported.Create(const ASituation: String); // 9
- begin
- inherited Create(NOT_SUPPORTED_ERR, ASituation);
- end;
- constructor EDOMInUseAttribute.Create(const ASituation: String); // 10
- begin
- inherited Create(INUSE_ATTRIBUTE_ERR, ASituation);
- end;
- constructor EDOMInvalidState.Create(const ASituation: String); // 11
- begin
- inherited Create(INVALID_STATE_ERR, ASituation);
- end;
- constructor EDOMSyntax.Create(const ASituation: String); // 12
- begin
- inherited Create(SYNTAX_ERR, ASituation);
- end;
- constructor EDOMInvalidModification.Create(const ASituation: String); // 13
- begin
- inherited Create(INVALID_MODIFICATION_ERR, ASituation);
- end;
- constructor EDOMNamespace.Create(const ASituation: String); // 14
- begin
- inherited Create(NAMESPACE_ERR, ASituation);
- end;
- constructor EDOMInvalidAccess.Create(const ASituation: String); // 15
- begin
- inherited Create(INVALID_ACCESS_ERR, ASituation);
- end;
- // -------------------------------------------------------
- // Node
- // -------------------------------------------------------
- constructor TDOMNode.Create(AOwner: TDOMDocument);
- begin
- FOwnerDocument := AOwner;
- inherited Create;
- end;
- destructor TDOMNode.Destroy;
- begin
- if Assigned(FParentNode) then
- FParentNode.DetachChild(Self);
- inherited Destroy;
- end;
- procedure TDOMNode.FreeInstance;
- begin
- if Assigned(FPool) then
- begin
- CleanupInstance;
- TNodePool(FPool).FreeNode(Self);
- end
- else
- inherited FreeInstance;
- end;
- function TDOMNode.GetNodeValue: DOMString;
- begin
- Result := '';
- end;
- procedure TDOMNode.SetNodeValue(const AValue: DOMString);
- begin
- // do nothing
- end;
- function TDOMNode.GetChildNodes: TDOMNodeList;
- begin
- Result := FOwnerDocument.GetChildNodeList(Self);
- end;
- function TDOMNode.GetFirstChild: TDOMNode;
- begin
- Result := nil;
- end;
- function TDOMNode.GetLastChild: TDOMNode;
- begin
- Result := nil;
- end;
- function TDOMNode.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
- parent := n.ParentNode;
- while Assigned(parent) and (parent.NodeType <> ELEMENT_NODE) do
- parent := parent.ParentNode;
- Result := TDOMElement(parent);
- 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;
- case NodeType of
- ELEMENT_NODE:
- 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;
- result := GetAncestorElement(Self).LookupNamespaceURI(APrefix);
- end;
- DOCUMENT_NODE:
- result := TDOMDocument(Self).documentElement.LookupNamespaceURI(APrefix);
- ATTRIBUTE_NODE:
- result := TDOMAttr(Self).OwnerElement.LookupNamespaceURI(APrefix);
- else
- Result := GetAncestorElement(Self).LookupNamespaceURI(APrefix);
- end;
- end;
- //------------------------------------------------------------------------------
- function CompareDOMNodeWithDOMNode(Node1, Node2: Pointer): integer;
- begin
- Result := TDOMNode(Node2).CompareName(TDOMNode(Node1).NodeName);
- end;
- function CompareDOMStringWithDOMNode(AKey, ANode: Pointer): integer;
- begin
- Result := TDOMNode(ANode).CompareName(PDOMString(AKey)^);
- 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;
- FreeAndNil(FChildNodeTree);
- 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;
- AddToChildNodeTree(NewChild);
- end;
- function TDOMNode_WithChildren.ReplaceChild(NewChild, OldChild: TDOMNode):
- TDOMNode;
- begin
- RemoveFromChildNodeTree(OldChild);
- 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;
- RemoveFromChildNodeTree(OldChild);
- // Make sure removed child does not contain references to nowhere
- OldChild.FPreviousSibling := nil;
- OldChild.FNextSibling := nil;
- OldChild.FParentNode := nil;
- Result := OldChild;
- end;
- function TDOMNode_WithChildren.HasChildNodes: Boolean;
- begin
- Result := Assigned(FFirstChild);
- end;
- function TDOMNode_WithChildren.FindNode(const ANodeName: DOMString): TDOMNode;
- var AVLNode: TAVLTreeNode;
- begin
- Result:=nil;
- if FChildNodeTree<>nil then begin
- AVLNode:=FChildNodeTree.FindKey(Pointer(@ANodeName),
- @CompareDOMStringWithDOMNode);
- if AVLNode<>nil then
- Result:=TDOMNode(AVLNode.Data);
- end;
- end;
- procedure TDOMNode_WithChildren.CloneChildren(ACopy: TDOMNode;
- ACloneOwner: TDOMDocument);
- var
- node: TDOMNode;
- begin
- node := FirstChild;
- while Assigned(node) do
- begin
- ACopy.AppendChild(node.CloneNode(True, ACloneOwner));
- node := node.NextSibling;
- end;
- end;
- procedure TDOMNode_WithChildren.FreeChildren;
- var
- child, next: TDOMNode;
- begin
- if Assigned(FChildNodeTree) then
- FChildNodeTree.Clear;
- 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;
- procedure TDOMNode_WithChildren.AddToChildNodeTree(NewNode: TDOMNode);
- begin
- if FChildNodeTree=nil then
- FChildNodeTree:=TAVLTree.Create(@CompareDOMNodeWithDOMNode);
- if FChildNodeTree.Find(NewNode)=nil then
- FChildNodeTree.Add(NewNode);
- end;
- procedure TDOMNode_WithChildren.RemoveFromChildNodeTree(OldNode: TDOMNode);
- begin
- if FChildNodeTree<>nil then
- FChildNodeTree.Remove(OldNode);
- end;
- // -------------------------------------------------------
- // NodeList
- // -------------------------------------------------------
- constructor TDOMNodeList.Create(ANode: TDOMNode);
- begin
- inherited Create;
- FNode := ANode;
- FRevision := ANode.GetRevision-1; // force BuildList at first access
- FList := TFPList.Create;
- end;
- destructor TDOMNodeList.Destroy;
- begin
- if (FNode is TDOMNode_WithChildren) and
- (TDOMNode_WithChildren(FNode).FChildNodes = Self) then
- TDOMNode_WithChildren(FNode).FChildNodes := nil
- else
- FNode.FOwnerDocument.NodeListDestroyed(Self);
- FList.Free;
- inherited Destroy;
- end;
- function TDOMNodeList.NodeFilter(aNode: TDOMNode): TFilterResult;
- begin
- // accept all nodes but don't allow recursion
- Result := frNorecurseTrue;
- end;
- procedure TDOMNodeList.BuildList;
- var
- current, next: TDOMNode;
- res: TFilterResult;
- begin
- FList.Clear;
- FRevision := FNode.GetRevision; // refresh
- current := FNode.FirstChild;
- while Assigned(current) do
- begin
- res := NodeFilter(current);
- if res in [frTrue, frNorecurseTrue] then
- FList.Add(current);
- next := nil;
- if res in [frTrue, frFalse] then
- next := current.FirstChild;
- if next = nil then
- begin
- while current <> FNode do
- begin
- next := current.NextSibling;
- if Assigned(next) then
- Break;
- current := current.ParentNode;
- end;
- end;
- current := next;
- end;
- end;
- function TDOMNodeList.GetCount: LongWord;
- begin
- if FRevision <> FNode.GetRevision then
- BuildList;
- Result := FList.Count;
- end;
- function TDOMNodeList.GetItem(index: LongWord): TDOMNode;
- begin
- if FRevision <> FNode.GetRevision then
- BuildList;
- if index < LongWord(FList.Count) then
- Result := TDOMNode(FList.List^[index])
- else
- Result := nil;
- end;
- { TDOMElementList }
- constructor TDOMElementList.Create(ANode: TDOMNode; const AFilter: DOMString);
- begin
- inherited Create(ANode);
- filter := AFilter;
- UseFilter := filter <> '*';
- end;
- constructor TDOMElementList.Create(ANode: TDOMNode; const nsURI, localName: DOMString);
- begin
- inherited Create(ANode);
- localNameFilter := localName;
- FMatchNS := True;
- FMatchAnyNS := (nsURI = '*');
- if not FMatchAnyNS then
- FNSIndexFilter := ANode.FOwnerDocument.IndexOfNS(nsURI);
- UseFilter := (localName <> '*');
- end;
- function TDOMElementList.NodeFilter(aNode: TDOMNode): TFilterResult;
- var
- I, L: Integer;
- begin
- Result := frFalse;
- if aNode.NodeType = ELEMENT_NODE then with TDOMElement(aNode) do
- begin
- if FMatchNS then
- begin
- if (FMatchAnyNS or (FNSI.NSIndex = Word(FNSIndexFilter))) then
- begin
- I := FNSI.PrefixLen;
- L := system.Length(FNSI.QName^.Key);
- if (not UseFilter or ((L-I = system.Length(localNameFilter)) and
- CompareMem(@FNSI.QName^.Key[I+1], DOMPChar(localNameFilter), system.Length(localNameFilter)*sizeof(WideChar)))) then
- Result := frTrue;
- end;
- end
- else if (not UseFilter or (TagName = Filter)) then
- Result := frTrue;
- end;
- end;
- // -------------------------------------------------------
- // NamedNodeMap
- // -------------------------------------------------------
- constructor TDOMNamedNodeMap.Create(AOwner: TDOMNode; ANodeType: Integer);
- begin
- inherited Create;
- FOwner := AOwner;
- FNodeType := ANodeType;
- FList := TFPList.Create;
- end;
- destructor TDOMNamedNodeMap.Destroy;
- var
- I: Integer;
- begin
- for I := FList.Count-1 downto 0 do
- TDOMNode(FList[I]).Free;
- FList.Free;
- inherited Destroy;
- end;
- function TDOMNamedNodeMap.GetItem(index: LongWord): TDOMNode;
- begin
- if index < LongWord(FList.Count) then
- Result := TDOMNode(FList.List^[index])
- else
- Result := nil;
- end;
- function TDOMNamedNodeMap.GetLength: LongWord;
- begin
- Result := FList.Count;
- end;
- function TDOMNamedNodeMap.Find(const name: DOMString; out Index: LongWord): Boolean;
- var
- L, H, I, C: Integer;
- begin
- Result := False;
- L := 0;
- H := FList.Count - 1;
- while L <= H do
- begin
- I := (L + H) shr 1;
- C := TDOMNode(FList.List^[I]).CompareName(name);
- if C > 0 then L := I + 1 else
- begin
- H := I - 1;
- if C = 0 then
- begin
- Result := True;
- L := I;
- end;
- end;
- end;
- Index := L;
- end;
- function TDOMNamedNodeMap.GetNamedItem(const name: DOMString): TDOMNode;
- var
- i: Cardinal;
- begin
- if Find(name, i) then
- Result := TDOMNode(FList.List^[i])
- else
- Result := nil;
- end;
- // Note: this *may* raise NOT_SUPPORTED_ERR if the document is e.g. HTML.
- // This isn't checked now.
- function TDOMNamedNodeMap.GetNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode;
- begin
- Result := nil;
- end;
- function TDOMNamedNodeMap.ValidateInsert(arg: TDOMNode): Integer;
- 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 := Find(TDOMAttr(arg).Name, i); // optimization
- end
- else
- Exists := Find(arg.NodeName, i);
- if Exists then
- begin
- Result := TDOMNode(FList.List^[i]);
- if (Result <> arg) and (FNodeType = ATTRIBUTE_NODE) then
- TDOMAttr(Result).FOwnerElement := nil;
- FList.List^[i] := arg;
- exit;
- end;
- FList.Insert(i, arg);
- Result := nil;
- end;
- function TDOMNamedNodeMap.SetNamedItemNS(arg: TDOMNode): TDOMNode;
- begin
- { Since the map contains only namespaceless nodes (all having empty
- localName and namespaceURI properties), a namespaced arg won't match
- any of them. Therefore, add it using nodeName as key.
- Note: a namespaceless arg is another story, as it will match *any* node
- in the map. This can be considered as a flaw in specs. }
- Result := SetNamedItem(arg);
- end;
- function TDOMNamedNodeMap.Delete(index: LongWord): TDOMNode;
- begin
- Result := TDOMNode(FList.List^[index]);
- FList.Delete(index);
- 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 Find(name, i) then
- begin
- Result := Delete(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 Index: LongWord): Boolean;
- var
- I: Integer;
- P: DOMPChar;
- begin
- for I := 0 to FList.Count-1 do
- begin
- with TDOMAttr(FList.List^[I]) do
- begin
- if nsIndex = FNSI.NSIndex then
- begin
- P := DOMPChar(FNSI.QName^.Key);
- if FNSI.PrefixLen > 1 then
- Inc(P, FNSI.PrefixLen);
- if CompareDOMStrings(DOMPChar(aLocalName), P, System.Length(aLocalName), System.Length(FNSI.QName^.Key) - FNSI.PrefixLen) = 0 then
- begin
- Index := I;
- Result := True;
- Exit;
- end;
- end;
- end;
- end;
- Result := False;
- end;
- function TAttributeMap.InternalRemoveNS(const nsURI, aLocalName: DOMString): TDOMNode;
- var
- i: Cardinal;
- nsIndex: Integer;
- begin
- Result := nil;
- nsIndex := FOwner.FOwnerDocument.IndexOfNS(nsURI);
- if (nsIndex >= 0) and FindNS(nsIndex, aLocalName, i) then
- begin
- Result := Delete(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(FList.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(FList.List^[i]);
- FList.Delete(i);
- end;
- // Do a non-namespace search in order to keep the list sorted on nodeName
- Exists := Find(FNSI.QName^.Key, i);
- if Exists and (Result = nil) then // case when arg has no namespace
- begin
- Result := TDOMNode(FList.List^[i]);
- FList.List^[i] := arg;
- end
- else
- FList.Insert(i, arg);
- end;
- if Assigned(Result) then
- 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(WideChar(':'), QName);
- if Result > 0 then
- begin
- for I := Result+1 to L-1 do // check for second colon (Use IndexWord?)
- if QName[I] = ':' then
- begin
- Result := -NAMESPACE_ERR;
- Exit;
- end;
- // Name validity has already been checked by IsXmlName() call above.
- // So just check that colon isn't first or last char, and that it is follwed by NameStartChar.
- if ((Result = 1) or (Result = L) or not IsXmlName(@QName[Result+1], 1, 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(WideString('xmlns'), QName) = 1)) <> (nsIdx = 2)) or
- // Bad usage of 'http://www.w3.org/XML/1998/namespace'
- ((Result = 4) and (Pos(WideString('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);
- 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);
- if not Exists then
- begin
- p^.Data := Attr.OwnerElement;
- Result := True;
- end
- else
- Result := False;
- 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.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(WideChar)) + Length(aLocalName);
- if UseNS then
- Inc(L, Length(nsURI)+1);
- GetMem(Key, L*sizeof(WideChar));
- try
- // compose the key for hashing
- P := Key;
- PPointer(P)^ := aNode;
- Inc(PPointer(P));
- Move(DOMPChar(aLocalName)^, P^, Length(aLocalName)*sizeof(WideChar));
- if UseNS then
- begin
- Inc(P, Length(aLocalName));
- P^ := #12; Inc(P); // separator -- diff ('foo','bar') from 'foobar'
- Move(DOMPChar(nsURI)^, P^, Length(nsURI)*sizeof(WideChar));
- end;
- // try finding in the hashtable
- Item := FNodeLists.FindOrAdd(Key, L);
- Result := TDOMNodeList(Item^.Data);
- if Result = nil then
- begin
- if UseNS then
- Result := TDOMElementList.Create(aNode, nsURI, aLocalName)
- else
- Result := TDOMElementList.Create(aNode, aLocalName);
- Item^.Data := Result;
- end;
- finally
- FreeMem(Key);
- end;
- end;
- function TDOMDocument.GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
- begin
- Result := GetElementList(Self, '', tagname, False);
- end;
- function TDOMDocument.GetElementsByTagNameNS(const nsURI, aLocalName: DOMString): TDOMNodeList;
- begin
- Result := GetElementList(Self, nsURI, aLocalName, True);
- end;
- { This is linear hence slow. However:
- - if user code frees each nodelist ASAP, there are only few items in the hashtable
- - if user code does not free nodelists, this is not called at all.
- }
- procedure TDOMDocument.NodeListDestroyed(aList: TDOMNodeList);
- begin
- if not (nfDestroying in FFlags) 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(WideChar(':'), 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;
- 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;
- procedure TDOMElement.RestoreDefaultAttr(AttrDef: TDOMAttr);
- var
- Attr: TDOMAttr;
- ColonPos: Integer;
- AttrName, nsuri: DOMString;
- begin
- Attr := TDOMAttr(AttrDef.CloneNode(True));
- AttrName := Attr.Name;
- ColonPos := Pos(WideChar(':'), 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.Find(name, I) then
- Attr := FAttributes[I] as TDOMAttr
- else
- begin
- Attr := FOwnerDocument.CreateAttribute(name);
- Attr.FOwnerElement := Self;
- FAttributes.FList.Insert(I, Attr);
- end;
- attr.NodeValue := value;
- end;
- procedure TDOMElement.RemoveAttribute(const name: DOMString);
- begin
- Changing;
- // (note) NamedNodeMap.RemoveNamedItem can raise NOT_FOUND_ERR and we should not.
- if Assigned(FAttributes) then
- FAttributes.InternalRemove(name).Free;
- end;
- procedure TDOMElement.RemoveAttributeNS(const nsURI,
- aLocalName: DOMString);
- begin
- Changing;
- if Assigned(FAttributes) then
- TAttributeMap(FAttributes).InternalRemoveNS(nsURI, aLocalName).Free;
- end;
- procedure TDOMElement.SetAttributeNS(const nsURI, qualifiedName,
- value: DOMString);
- var
- I: Cardinal;
- Attr: TDOMAttr;
- idx, prefIdx: Integer;
- 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.FList.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.Find(qualifiedName, I);
- FAttributes.FList.Insert(I, Attr);
- // TODO: rehash properly, same issue as with Node.SetPrefix()
- Attr.FNSI.QName := FOwnerDocument.FNames.FindOrAdd(DOMPChar(qualifiedName), Length(qualifiedName));
- Attr.FNSI.PrefixLen := Word(prefIdx);
- attr.NodeValue := value;
- end;
- function TDOMElement.GetAttributeNode(const name: DOMString): TDOMAttr;
- begin
- if Assigned(FAttributes) then
- Result := FAttributes.GetNamedItem(name) as TDOMAttr
- else
- Result := nil;
- end;
- function TDOMElement.GetAttributeNodeNS(const nsURI, aLocalName: DOMString): TDOMAttr;
- begin
- if Assigned(FAttributes) then
- Result := FAttributes.GetNamedItemNS(nsURI, aLocalName) as TDOMAttr
- else
- Result := nil;
- end;
- function TDOMElement.SetAttributeNode(NewAttr: TDOMAttr): TDOMAttr;
- begin
- Result := Attributes.SetNamedItem(NewAttr) as TDOMAttr;
- end;
- function TDOMElement.SetAttributeNodeNS(NewAttr: TDOMAttr): TDOMAttr;
- begin
- Result := Attributes.SetNamedItemNS(NewAttr) as TDOMAttr;
- end;
- function TDOMElement.RemoveAttributeNode(OldAttr: TDOMAttr): TDOMAttr;
- begin
- Changing;
- Result:=nil;
- // TODO: DOM 2: must raise NOT_FOUND_ERR if OldAttr is not ours.
- // -- but what is the purpose of return value then?
- // TODO: delegate to TNamedNodeMap? Nope, it does not have such method
- // (note) one way around is to remove by name
- if Assigned(FAttributes) and (FAttributes.FList.Remove(OldAttr) > -1) then
- begin
- Result := OldAttr;
- if Assigned(OldAttr.FNSI.QName) then // safeguard
- FAttributes.RestoreDefault(OldAttr.FNSI.QName^.Key);
- 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: Pointer;
- sz: Integer;
- begin
- ext := FCurrExtent;
- ptr := Pointer(FCurrBlock) + FElementSize;
- sz := FCurrExtentSize;
- while Assigned(ext) do
- begin
- // call destructors for everyone still there
- ptr_end := Pointer(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 := Pointer(ext) + sizeof(TExtent);
- end;
- inherited Destroy;
- end;
- procedure TNodePool.AddExtent(AElemCount: Integer);
- var
- ext: PExtent;
- begin
- Assert((FCurrExtent = nil) or
- (Pointer(FCurrBlock) = Pointer(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(Pointer(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 Pointer(FCurrBlock) = Pointer(FCurrExtent) + sizeof(TExtent) then
- AddExtent(FCurrExtentSize * 2);
- Result := FCurrBlock;
- Dec(PChar(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.
|