123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564 |
- {
- This file is part of the Free Component Library
- Implementation of DOM interfaces
- Copyright (c) 1999-2000 by Sebastian Guenther, [email protected]
- Modified in 2006 by Sergei Gorelkin, [email protected]
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- {
- This unit provides classes which implement the interfaces defined in the
- DOM (Document Object Model) specification.
- The current state is:
- DOM Levels 1 and 2 - Completely implemented
- DOM Level 3 - Partially implemented
- Specification used for this implementation:
- "Document Object Model (DOM) Level 2 Specification Version 1.0
- W3C Recommendation 11 November, 2000"
- http://www.w3.org/TR/2000/REC-DOM-Level-2-Core-20001113
- }
- unit DOM;
- {$ifdef fpc}
- {$MODE objfpc}{$H+}
- {$endif}
- interface
- uses
- SysUtils, Classes, xmlutils, dtdmodel;
- // -------------------------------------------------------
- // DOMException
- // -------------------------------------------------------
- const
- // DOM Level 1 exception codes:
- INDEX_SIZE_ERR = 1; // index or size is negative, or greater than the allowed value
- DOMSTRING_SIZE_ERR = 2; // Specified range of text does not fit into a DOMString
- HIERARCHY_REQUEST_ERR = 3; // node is inserted somewhere it does not belong
- WRONG_DOCUMENT_ERR = 4; // node is used in a different document than the one that created it (that does not support it)
- INVALID_CHARACTER_ERR = 5; // invalid or illegal character is specified, such as in a name
- NO_DATA_ALLOWED_ERR = 6; // data is specified for a node which does not support data
- NO_MODIFICATION_ALLOWED_ERR = 7; // an attempt is made to modify an object where modifications are not allowed
- NOT_FOUND_ERR = 8; // an attempt is made to reference a node in a context where it does not exist
- NOT_SUPPORTED_ERR = 9; // implementation does not support the type of object requested
- INUSE_ATTRIBUTE_ERR = 10; // an attempt is made to add an attribute that is already in use elsewhere
- // DOM Level 2 exception codes:
- INVALID_STATE_ERR = 11; // an attempt is made to use an object that is not, or is no longer, usable
- SYNTAX_ERR = 12; // invalid or illegal string specified
- INVALID_MODIFICATION_ERR = 13; // an attempt is made to modify the type of the underlying object
- NAMESPACE_ERR = 14; // an attempt is made to create or change an object in a way which is incorrect with regard to namespaces
- INVALID_ACCESS_ERR = 15; // parameter or operation is not supported by the underlying object
- // -------------------------------------------------------
- // Node
- // -------------------------------------------------------
- const
- ELEMENT_NODE = 1;
- ATTRIBUTE_NODE = 2;
- TEXT_NODE = 3;
- CDATA_SECTION_NODE = 4;
- ENTITY_REFERENCE_NODE = 5;
- ENTITY_NODE = 6;
- PROCESSING_INSTRUCTION_NODE = 7;
- COMMENT_NODE = 8;
- DOCUMENT_NODE = 9;
- DOCUMENT_TYPE_NODE = 10;
- DOCUMENT_FRAGMENT_NODE = 11;
- NOTATION_NODE = 12;
- type
- TDOMDocument = class;
- TDOMNodeList = class;
- TDOMNamedNodeMap = class;
- TDOMAttr = class;
- TDOMElement = class;
- TDOMText = class;
- TDOMComment = class;
- TDOMCDATASection = class;
- TDOMDocumentType = class;
- TDOMEntityReference = class;
- TDOMProcessingInstruction = class;
- TNodePool = class;
- PNodePoolArray = ^TNodePoolArray;
- TNodePoolArray = array[0..MaxInt div sizeof(Pointer)-1] of TNodePool;
- {$ifndef fpc}
- TFPList = TList;
- {$endif}
- // -------------------------------------------------------
- // DOMString
- // -------------------------------------------------------
- TSetOfChar = xmlutils.TSetOfChar; { to be removed: not used in DOM unit }
- DOMString = XMLString;
- DOMPChar = PXMLChar;
- PDOMString = ^DOMString;
- EDOMError = class(Exception)
- public
- Code: Integer;
- constructor Create(ACode: Integer; const ASituation: String);
- end;
- EDOMIndexSize = class(EDOMError)
- public
- constructor Create(const ASituation: String);
- end;
- EDOMHierarchyRequest = class(EDOMError)
- public
- constructor Create(const ASituation: String);
- end;
- EDOMWrongDocument = class(EDOMError)
- public
- constructor Create(const ASituation: String);
- end;
- EDOMNotFound = class(EDOMError)
- public
- constructor Create(const ASituation: String);
- end;
- EDOMNotSupported = class(EDOMError)
- public
- constructor Create(const ASituation: String);
- end;
- EDOMInUseAttribute = class(EDOMError)
- public
- constructor Create(const ASituation: String);
- end;
- EDOMInvalidState = class(EDOMError)
- public
- constructor Create(const ASituation: String);
- end;
- EDOMSyntax = class(EDOMError)
- public
- constructor Create(const ASituation: String);
- end;
- EDOMInvalidModification = class(EDOMError)
- public
- constructor Create(const ASituation: String);
- end;
- EDOMNamespace = class(EDOMError)
- public
- constructor Create(const ASituation: String);
- end;
- EDOMInvalidAccess = class(EDOMError)
- public
- constructor Create(const ASituation: String);
- end;
- { NodeType, NodeName and NodeValue had been moved from fields to functions.
- This lowers memory usage and also obsoletes most constructors,
- at a slight performance penalty. However, NodeName and NodeValue are
- accessible via fields using specialized properties of descendant classes,
- e.g. TDOMElement.TagName, TDOMCharacterData.Data etc.}
- TNodeFlagEnum = (
- nfReadonly,
- nfRecycled,
- nfLevel2,
- nfIgnorableWS,
- nfSpecified,
- nfDestroying,
- nfFirstChild
- );
- TNodeFlags = set of TNodeFlagEnum;
- TDOMNode = class
- protected
- FPool: TObject;
- FFlags: TNodeFlags;
- FParentNode: TDOMNode;
- FPreviousSibling, FNextSibling: TDOMNode;
- FOwnerDocument: TDOMDocument;
- function GetNodeName: DOMString; virtual; abstract;
- function GetNodeValue: DOMString; virtual;
- function GetParentNode: TDOMNode; virtual;
- procedure SetNodeValue(const AValue: DOMString); virtual;
- function GetFirstChild: TDOMNode; virtual;
- function GetLastChild: TDOMNode; virtual;
- function GetPreviousSibling: TDOMNode; virtual;
- function GetAttributes: TDOMNamedNodeMap; virtual;
- function GetRevision: Integer;
- function GetNodeType: Integer; virtual; abstract;
- function GetTextContent: DOMString; virtual;
- procedure SetTextContent(const AValue: DOMString); virtual;
- function GetLocalName: DOMString; virtual;
- function GetNamespaceURI: DOMString; virtual;
- function GetPrefix: DOMString; virtual;
- procedure SetPrefix(const Value: DOMString); virtual;
- function GetOwnerDocument: TDOMDocument; virtual;
- function GetBaseURI: DOMString;
- procedure 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 GetParentNode;
- property FirstChild: TDOMNode read GetFirstChild;
- property LastChild: TDOMNode read GetLastChild;
- property ChildNodes: TDOMNodeList read GetChildNodes;
- property PreviousSibling: TDOMNode read GetPreviousSibling;
- property NextSibling: TDOMNode read FNextSibling;
- property Attributes: TDOMNamedNodeMap read GetAttributes;
- property OwnerDocument: TDOMDocument read GetOwnerDocument;
- function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; virtual;
- function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; virtual;
- function DetachChild(OldChild: TDOMNode): TDOMNode; virtual;
- function RemoveChild(OldChild: TDOMNode): TDOMNode;
- function AppendChild(NewChild: TDOMNode): TDOMNode;
- function HasChildNodes: Boolean; virtual;
- function CloneNode(deep: Boolean): TDOMNode; overload; virtual;
- // DOM level 2
- function IsSupported(const Feature, Version: DOMString): Boolean;
- function HasAttributes: Boolean; virtual;
- procedure Normalize; virtual;
- property NamespaceURI: DOMString read GetNamespaceURI;
- property LocalName: DOMString read GetLocalName;
- property Prefix: DOMString read GetPrefix write SetPrefix;
- // DOM level 3
- property TextContent: DOMString read GetTextContent write SetTextContent;
- function LookupPrefix(const nsURI: DOMString): DOMString;
- function LookupNamespaceURI(const APrefix: DOMString): DOMString;
- function IsDefaultNamespace(const nsURI: DOMString): Boolean;
- property baseURI: DOMString read GetBaseURI;
- // Extensions to DOM interface:
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; virtual;
- function FindNode(const ANodeName: DOMString): TDOMNode; virtual;
- function CompareName(const name: DOMString): Integer; virtual;
- property Flags: TNodeFlags read FFlags;
- end;
- TDOMNodeClass = class of TDOMNode;
- { The following class is an implementation specific extension, it is just an
- extended implementation of TDOMNode, the generic DOM::Node interface
- implementation. (Its main purpose is to save memory in a big node tree) }
- TDOMNode_WithChildren = class(TDOMNode)
- protected
- FFirstChild: TDOMNode;
- FChildNodes: TDOMNodeList;
- function GetFirstChild: TDOMNode; override;
- function GetLastChild: TDOMNode; override;
- procedure CloneChildren(ACopy: TDOMNode; ACloneOwner: TDOMDocument);
- procedure FreeChildren;
- function GetTextContent: DOMString; override;
- procedure SetTextContent(const AValue: DOMString); override;
- public
- destructor Destroy; override;
- function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; override;
- function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; override;
- function DetachChild(OldChild: TDOMNode): TDOMNode; override;
- function HasChildNodes: Boolean; override;
- function FindNode(const ANodeName: DOMString): TDOMNode; override;
- procedure InternalAppend(NewChild: TDOMNode);
- end;
- { A common ancestor for Document and Entity nodes. }
- TDOMNode_TopLevel = class(TDOMNode_WithChildren)
- protected
- FInputEncoding: DOMString;
- FXMLEncoding: DOMString;
- FURI: DOMString;
- FXMLVersion: TXMLVersion;
- function GetXMLVersion: DOMString;
- public
- property InputEncoding: DOMString read FInputEncoding;
- property XMLEncoding: DOMString read FXMLEncoding;
- end;
- // -------------------------------------------------------
- // NodeList
- // -------------------------------------------------------
- TFilterResult = (frFalse, frNorecurseFalse, frTrue, frNorecurseTrue);
- TDOMNodeList = class(TObject)
- protected
- FNode: TDOMNode;
- FRevision: Integer;
- FList: TFPList;
- function GetCount: LongWord;
- function GetItem(index: LongWord): TDOMNode;
- function NodeFilter(aNode: TDOMNode): TFilterResult; virtual;
- // now deprecated in favor of NodeFilter
- procedure BuildList; virtual;
- public
- constructor Create(ANode: TDOMNode);
- destructor Destroy; override;
- property Item[index: LongWord]: TDOMNode read GetItem; default;
- property Count: LongWord read GetCount;
- property Length: LongWord read GetCount;
- end;
- { an extension to DOM interface, used to build recursive lists of elements }
- TDOMElementList = class(TDOMNodeList)
- protected
- filter: DOMString;
- FNSIndexFilter: Integer;
- localNameFilter: DOMString;
- FMatchNS: Boolean;
- FMatchAnyNS: Boolean;
- UseFilter: Boolean;
- function NodeFilter(aNode: TDOMNode): TFilterResult; override;
- public
- constructor Create(ANode: TDOMNode; const AFilter: DOMString); overload;
- constructor Create(ANode: TDOMNode; const nsURI, localName: DOMString); overload;
- end;
- // -------------------------------------------------------
- // NamedNodeMap
- // -------------------------------------------------------
- TDOMNamedNodeMap = class(TObject)
- protected
- FOwner: TDOMNode;
- FList: TFPList;
- function GetItem(index: LongWord): TDOMNode;
- function GetLength: LongWord;
- function Find(const name: DOMString; out Index: LongWord): Boolean;
- function Delete(index: LongWord): TDOMNode; virtual;
- function InternalRemove(const name: DOMString): TDOMNode;
- function ValidateInsert(arg: TDOMNode): Integer; virtual;
- public
- constructor Create(AOwner: TDOMNode);
- destructor Destroy; override;
- function GetNamedItem(const name: DOMString): TDOMNode;
- function SetNamedItem(arg: TDOMNode): TDOMNode; virtual;
- function RemoveNamedItem(const name: DOMString): TDOMNode;
- // Introduced in DOM Level 2:
- function getNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode; virtual;
- function setNamedItemNS(arg: TDOMNode): TDOMNode; virtual;
- function removeNamedItemNS(const namespaceURI,localName: DOMString): TDOMNode; virtual;
- property Item[index: LongWord]: TDOMNode read GetItem; default;
- property Length: LongWord read GetLength;
- end;
- // -------------------------------------------------------
- // CharacterData
- // -------------------------------------------------------
- TDOMCharacterData = class(TDOMNode)
- private
- FNodeValue: DOMString;
- protected
- function GetLength: LongWord;
- function GetNodeValue: DOMString; override;
- procedure SetNodeValue(const AValue: DOMString); override;
- public
- property Data: DOMString read FNodeValue write SetNodeValue;
- property Length: LongWord read GetLength;
- function SubstringData(offset, count: LongWord): DOMString;
- procedure AppendData(const arg: DOMString);
- procedure InsertData(offset: LongWord; const arg: DOMString);
- procedure DeleteData(offset, count: LongWord);
- procedure ReplaceData(offset, count: LongWord; const arg: DOMString);
- end;
- // -------------------------------------------------------
- // DOMImplementation
- // -------------------------------------------------------
- TDOMImplementation = class
- public
- function HasFeature(const feature, version: DOMString): Boolean;
- // Introduced in DOM Level 2:
- function CreateDocumentType(const QualifiedName, PublicID,
- SystemID: DOMString): TDOMDocumentType;
- function CreateDocument(const NamespaceURI, QualifiedName: DOMString;
- doctype: TDOMDocumentType): TDOMDocument;
- end;
- // -------------------------------------------------------
- // DocumentFragment
- // -------------------------------------------------------
- TDOMDocumentFragment = class(TDOMNode_WithChildren)
- protected
- function GetNodeType: Integer; override;
- function GetNodeName: DOMString; override;
- public
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- end;
- // -------------------------------------------------------
- // Document
- // -------------------------------------------------------
- // TODO: to be replaced by more suitable container
- TNamespaces = array of DOMString;
- TDOMDocument = class(TDOMNode_TopLevel)
- protected
- FIDList: THashTable;
- FRevision: Integer;
- FImplementation: TDOMImplementation;
- FNamespaces: TNamespaces;
- FNames: THashTable;
- FEmptyNode: TDOMElement;
- FNodeLists: THashTable;
- FMaxPoolSize: Integer;
- FPools: PNodePoolArray;
- FXmlStandalone: Boolean;
- function GetDocumentElement: TDOMElement;
- function GetDocType: TDOMDocumentType;
- function GetNodeType: Integer; override;
- function GetNodeName: DOMString; override;
- function GetTextContent: DOMString; override;
- function GetOwnerDocument: TDOMDocument; override;
- procedure SetTextContent(const value: DOMString); override;
- procedure RemoveID(Elem: TDOMElement);
- function GetChildNodeList(aNode: TDOMNode): TDOMNodeList;
- function GetElementList(aNode: TDOMNode; const nsURI, aLocalName: DOMString; UseNS: Boolean): TDOMNodeList;
- procedure NodeListDestroyed(aList: TDOMNodeList);
- function Alloc(AClass: TDOMNodeClass): TDOMNode;
- procedure SetXMLVersion(const aValue: DOMString); virtual;
- procedure SetXMLStandalone(aValue: Boolean); virtual;
- public
- function IndexOfNS(const nsURI: DOMString; AddIfAbsent: Boolean = False): Integer;
- function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; override;
- function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; override;
- property DocType: TDOMDocumentType read GetDocType;
- property Impl: TDOMImplementation read FImplementation;
- property DocumentElement: TDOMElement read GetDocumentElement;
- function CreateElement(const tagName: DOMString): TDOMElement; virtual;
- function CreateElementBuf(Buf: DOMPChar; Length: Integer): TDOMElement;
- function CreateDocumentFragment: TDOMDocumentFragment;
- function CreateTextNode(const data: DOMString): TDOMText;
- function CreateTextNodeBuf(Buf: DOMPChar; Length: Integer; IgnWS: Boolean): TDOMText;
- function CreateComment(const data: DOMString): TDOMComment;
- function CreateCommentBuf(Buf: DOMPChar; Length: Integer): TDOMComment;
- function CreateCDATASection(const data: DOMString): TDOMCDATASection;
- virtual;
- function CreateProcessingInstruction(const target, data: DOMString):
- TDOMProcessingInstruction; virtual;
- function CreateAttribute(const name: DOMString): TDOMAttr;
- function CreateAttributeBuf(Buf: DOMPChar; Length: Integer): TDOMAttr;
- function CreateEntityReference(const name: DOMString): TDOMEntityReference;
- virtual;
- function GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
- // DOM level 2 methods
- function ImportNode(ImportedNode: TDOMNode; Deep: Boolean): TDOMNode;
- function CreateElementNS(const nsURI, QualifiedName: DOMString): TDOMElement;
- function CreateAttributeNS(const nsURI, QualifiedName: DOMString): TDOMAttr;
- function GetElementsByTagNameNS(const nsURI, alocalName: DOMString): TDOMNodeList;
- function GetElementById(const ElementID: DOMString): TDOMElement;
- // DOM level 3:
- property documentURI: DOMString read FURI write FURI;
- property XMLVersion: DOMString read GetXMLVersion write SetXMLVersion;
- property XMLStandalone: Boolean read FXmlStandalone write SetXmlStandalone;
- // Extensions to DOM interface:
- constructor Create; virtual;
- destructor Destroy; override;
- function CloneNode(deep: Boolean): TDOMNode; overload; override;
- property Names: THashTable read FNames;
- property IDs: THashTable read FIDList write FIDList;
- end;
- TXMLDocument = class(TDOMDocument)
- protected
- procedure SetXMLVersion(const aValue: DOMString); override;
- procedure SetXMLStandalone(aValue: Boolean); override;
- public
- // These fields are extensions to the DOM interface:
- StylesheetType, StylesheetHRef: DOMString;
- constructor Create; override;
- function CreateCDATASection(const data: DOMString): TDOMCDATASection; override;
- function CreateProcessingInstruction(const target, data: DOMString):
- TDOMProcessingInstruction; override;
- function CreateEntityReference(const name: DOMString): TDOMEntityReference; override;
- end;
- // This limits number of namespaces per document to 65535,
- // and prefix length to 65535, too.
- // I believe that higher values may only be found in deliberately malformed documents.
- TNamespaceInfo = packed record
- NSIndex: Word;
- PrefixLen: Word;
- QName: PHashItem;
- end;
- // -------------------------------------------------------
- // Attr
- // -------------------------------------------------------
- TAttrDataType = xmlutils.TAttrDataType;
- TDOMNode_NS = class(TDOMNode_WithChildren)
- protected
- FNSI: TNamespaceInfo;
- function GetNodeName: DOMString; override;
- function GetLocalName: DOMString; override;
- function GetNamespaceURI: DOMString; override;
- function GetPrefix: DOMString; override;
- procedure SetPrefix(const Value: DOMString); override;
- public
- { Used by parser }
- procedure SetNSI(const nsUri: DOMString; ColonPos: Integer);
- function CompareName(const AName: DOMString): Integer; override;
- property NSI: TNamespaceInfo read FNSI;
- end;
- TDOMAttr = class(TDOMNode_NS)
- protected
- FDataType: TAttrDataType;
- function GetNodeValue: DOMString; override;
- function GetNodeType: Integer; override;
- function GetParentNode: TDOMNode; override;
- function GetSpecified: Boolean;
- function GetIsID: Boolean;
- function GetOwnerElement: TDOMElement;
- procedure SetNodeValue(const AValue: DOMString); override;
- public
- destructor Destroy; override;
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- property Name: DOMString read GetNodeName;
- property Specified: Boolean read GetSpecified;
- property Value: DOMString read GetNodeValue write SetNodeValue;
- property OwnerElement: TDOMElement read GetOwnerElement;
- property IsID: Boolean read GetIsID;
- // extensions
- // TODO: this is to be replaced with DOM 3 TypeInfo
- property DataType: TAttrDataType read FDataType write FDataType;
- end;
- // -------------------------------------------------------
- // Element
- // -------------------------------------------------------
- TDOMElement = class(TDOMNode_NS)
- protected
- FAttributes: TDOMNamedNodeMap;
- function GetNodeType: Integer; override;
- function GetAttributes: TDOMNamedNodeMap; override;
- procedure AttachDefaultAttrs;
- function InternalLookupPrefix(const nsURI: DOMString; Original: TDOMElement): DOMString;
- procedure RestoreDefaultAttr(AttrDef: TAttributeDef);
- public
- destructor Destroy; override;
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- procedure Normalize; override;
- property TagName: DOMString read GetNodeName;
- function GetAttribute(const name: DOMString): DOMString;
- procedure SetAttribute(const name, value: DOMString);
- procedure RemoveAttribute(const name: DOMString);
- function GetAttributeNode(const name: DOMString): TDOMAttr;
- function SetAttributeNode(NewAttr: TDOMAttr): TDOMAttr;
- function RemoveAttributeNode(OldAttr: TDOMAttr): TDOMAttr;
- function GetElementsByTagName(const name: DOMString): TDOMNodeList;
- // Introduced in DOM Level 2:
- function GetAttributeNS(const nsURI, aLocalName: DOMString): DOMString;
- procedure SetAttributeNS(const nsURI, qualifiedName, value: DOMString);
- procedure RemoveAttributeNS(const nsURI, aLocalName: DOMString);
- function GetAttributeNodeNS(const nsURI, aLocalName: DOMString): TDOMAttr;
- function SetAttributeNodeNS(newAttr: TDOMAttr): TDOMAttr;
- function GetElementsByTagNameNS(const nsURI, aLocalName: DOMString): TDOMNodeList;
- function hasAttribute(const name: DOMString): Boolean;
- function hasAttributeNS(const nsURI, aLocalName: DOMString): Boolean;
- function HasAttributes: Boolean; override;
- // extension
- property AttribStrings[const Name: DOMString]: DOMString
- read GetAttribute write SetAttribute; default;
- end;
- // -------------------------------------------------------
- // Text
- // -------------------------------------------------------
- TDOMText = class(TDOMCharacterData)
- protected
- function GetNodeType: Integer; override;
- function GetNodeName: DOMString; override;
- procedure SetNodeValue(const aValue: DOMString); override;
- public
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- function SplitText(offset: LongWord): TDOMText;
- function IsElementContentWhitespace: Boolean;
- end;
- // -------------------------------------------------------
- // Comment
- // -------------------------------------------------------
- TDOMComment = class(TDOMCharacterData)
- protected
- function GetNodeType: Integer; override;
- function GetNodeName: DOMString; override;
- public
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- end;
- // -------------------------------------------------------
- // CDATASection
- // -------------------------------------------------------
- TDOMCDATASection = class(TDOMText)
- protected
- function GetNodeType: Integer; override;
- function GetNodeName: DOMString; override;
- public
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- end;
- // -------------------------------------------------------
- // DocumentType
- // -------------------------------------------------------
- TDOMDocumentType = class(TDOMNode)
- protected
- FModel: TDTDModel;
- FEntities, FNotations: TDOMNamedNodeMap;
- function GetEntities: TDOMNamedNodeMap;
- function GetNotations: TDOMNamedNodeMap;
- function GetNodeType: Integer; override;
- function GetNodeName: DOMString; override;
- function GetPublicID: DOMString;
- function GetSystemID: DOMString;
- function GetInternalSubset: DOMString;
- public
- constructor Create(aOwner: TDOMDocument; aModel: TDTDModel);
- destructor Destroy; override;
- property Name: DOMString read GetNodeName;
- property Entities: TDOMNamedNodeMap read GetEntities;
- property Notations: TDOMNamedNodeMap read GetNotations;
- // Introduced in DOM Level 2:
- property PublicID: DOMString read GetPublicID;
- property SystemID: DOMString read GetSystemID;
- property InternalSubset: DOMString read GetInternalSubset;
- end;
- // -------------------------------------------------------
- // Notation
- // -------------------------------------------------------
- TDOMNotation = class(TDOMNode)
- protected
- FDecl: TNotationDecl;
- FBaseURI: DOMString;
- function GetNodeType: Integer; override;
- function GetNodeName: DOMString; override;
- function GetPublicID: DOMString;
- function GetSystemID: DOMString;
- public
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- property PublicID: DOMString read GetPublicID;
- property SystemID: DOMString read GetSystemID;
- end;
- // -------------------------------------------------------
- // Entity
- // -------------------------------------------------------
- TDOMEntity = class(TDOMNode_TopLevel)
- protected
- FDecl: TEntityDecl;
- FBaseURI: DOMString;
- function GetNodeType: Integer; override;
- function GetNodeName: DOMString; override;
- function GetPublicID: DOMString;
- function GetSystemID: DOMString;
- function GetNotationName: DOMString;
- public
- function CloneNode(deep: Boolean; aCloneOwner: TDOMDocument): TDOMNode; override;
- property PublicID: DOMString read GetPublicID;
- property SystemID: DOMString read GetSystemID;
- property NotationName: DOMString read GetNotationName;
- property XMLVersion: DOMString read GetXMLVersion;
- end;
- // -------------------------------------------------------
- // EntityReference
- // -------------------------------------------------------
- TDOMEntityReference = class(TDOMNode_WithChildren)
- protected
- FName: DOMString;
- function GetNodeType: Integer; override;
- function GetNodeName: DOMString; override;
- public
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- end;
- // -------------------------------------------------------
- // ProcessingInstruction
- // -------------------------------------------------------
- TDOMProcessingInstruction = class(TDOMNode)
- private
- FTarget: DOMString;
- FNodeValue: DOMString;
- protected
- function GetNodeType: Integer; override;
- function GetNodeName: DOMString; override;
- function GetNodeValue: DOMString; override;
- procedure SetNodeValue(const AValue: DOMString); override;
- public
- function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
- property Target: DOMString read FTarget;
- property Data: DOMString read FNodeValue write SetNodeValue;
- end;
- // TNodePool - custom memory management for TDOMNode's
- // One pool manages objects of the same InstanceSize (may be of various classes)
- PExtent = ^TExtent;
- TExtent = record
- Next: PExtent;
- // following: array of TDOMNode instances
- end;
- TNodePool = class(TObject)
- private
- FCurrExtent: PExtent;
- FCurrExtentSize: Integer;
- FElementSize: Integer;
- FCurrBlock: TDOMNode;
- FFirstFree: TDOMNode;
- procedure AddExtent(AElemCount: Integer);
- public
- constructor Create(AElementSize: Integer; AElementCount: Integer = 32);
- destructor Destroy; override;
- function AllocNode(AClass: TDOMNodeClass): TDOMNode;
- procedure FreeNode(ANode: TDOMNode);
- end;
- // temporary until things are settled
- function LoadElement(doc: TDOMDocument; src: PNodeData; attrCount: Integer): TDOMElement;
- // =======================================================
- // =======================================================
- implementation
- uses
- UriParser;
- { a namespace-enabled NamedNodeMap }
- type
- TAttributeMap = class(TDOMNamedNodeMap)
- private
- function FindNS(nsIndex: Integer; const aLocalName: DOMString;
- out Index: LongWord): Boolean;
- function InternalRemoveNS(const nsURI, aLocalName: DOMString): TDOMNode;
- procedure RestoreDefault(aName: PHashItem);
- protected
- function Delete(index: LongWord): TDOMNode; override;
- function ValidateInsert(arg: TDOMNode): Integer; override;
- public
- function setNamedItem(arg: TDOMNode): TDOMNode; override;
- function getNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode; override;
- function setNamedItemNS(arg: TDOMNode): TDOMNode; override;
- function removeNamedItemNS(const namespaceURI,localName: DOMString): TDOMNode; override;
- end;
- // -------------------------------------------------------
- // DOM Exception
- // -------------------------------------------------------
- constructor EDOMError.Create(ACode: Integer; const ASituation: String);
- begin
- Code := ACode;
- inherited Create(Self.ClassName + ' in ' + ASituation);
- end;
- constructor EDOMIndexSize.Create(const ASituation: String); // 1
- begin
- inherited Create(INDEX_SIZE_ERR, ASituation);
- end;
- constructor EDOMHierarchyRequest.Create(const ASituation: String); // 3
- begin
- inherited Create(HIERARCHY_REQUEST_ERR, ASituation);
- end;
- constructor EDOMWrongDocument.Create(const ASituation: String); // 4
- begin
- inherited Create(WRONG_DOCUMENT_ERR, ASituation);
- end;
- constructor EDOMNotFound.Create(const ASituation: String); // 8
- begin
- inherited Create(NOT_FOUND_ERR, ASituation);
- end;
- constructor EDOMNotSupported.Create(const ASituation: String); // 9
- begin
- inherited Create(NOT_SUPPORTED_ERR, ASituation);
- end;
- constructor EDOMInUseAttribute.Create(const ASituation: String); // 10
- begin
- inherited Create(INUSE_ATTRIBUTE_ERR, ASituation);
- end;
- constructor EDOMInvalidState.Create(const ASituation: String); // 11
- begin
- inherited Create(INVALID_STATE_ERR, ASituation);
- end;
- constructor EDOMSyntax.Create(const ASituation: String); // 12
- begin
- inherited Create(SYNTAX_ERR, ASituation);
- end;
- constructor EDOMInvalidModification.Create(const ASituation: String); // 13
- begin
- inherited Create(INVALID_MODIFICATION_ERR, ASituation);
- end;
- constructor EDOMNamespace.Create(const ASituation: String); // 14
- begin
- inherited Create(NAMESPACE_ERR, ASituation);
- end;
- constructor EDOMInvalidAccess.Create(const ASituation: String); // 15
- begin
- inherited Create(INVALID_ACCESS_ERR, ASituation);
- end;
- // -------------------------------------------------------
- // Node
- // -------------------------------------------------------
- constructor TDOMNode.Create(AOwner: TDOMDocument);
- begin
- FOwnerDocument := AOwner;
- inherited Create;
- end;
- destructor TDOMNode.Destroy;
- begin
- if Assigned(FParentNode) then
- FParentNode.DetachChild(Self);
- inherited Destroy;
- end;
- procedure TDOMNode.FreeInstance;
- begin
- if Assigned(FPool) then
- begin
- CleanupInstance;
- TNodePool(FPool).FreeNode(Self);
- end
- else
- inherited FreeInstance;
- end;
- function TDOMNode.GetNodeValue: DOMString;
- begin
- Result := '';
- end;
- function TDOMNode.GetParentNode: TDOMNode;
- begin
- Result := FParentNode;
- end;
- procedure TDOMNode.SetNodeValue(const AValue: DOMString);
- begin
- // do nothing
- end;
- function TDOMNode.GetChildNodes: TDOMNodeList;
- begin
- Result := FOwnerDocument.GetChildNodeList(Self);
- end;
- function TDOMNode.GetFirstChild: TDOMNode;
- begin
- Result := nil;
- end;
- function TDOMNode.GetLastChild: TDOMNode;
- begin
- Result := nil;
- end;
- function TDOMNode.GetPreviousSibling: TDOMNode;
- begin
- if nfFirstChild in FFlags then
- Result := nil
- else
- Result := FPreviousSibling;
- end;
- function TDOMNode.GetAttributes: TDOMNamedNodeMap;
- begin
- Result := nil;
- end;
- function TDOMNode.InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode;
- begin
- Changing; // merely to comply with core3/nodeinsertbefore14
- raise EDOMHierarchyRequest.Create('Node.InsertBefore');
- Result:=nil;
- end;
- function TDOMNode.ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode;
- begin
- Changing; // merely to comply with core3/nodereplacechild21
- raise EDOMHierarchyRequest.Create('Node.ReplaceChild');
- Result:=nil;
- end;
- function TDOMNode.DetachChild(OldChild: TDOMNode): TDOMNode;
- begin
- // OldChild isn't in our child list
- raise EDOMNotFound.Create('Node.RemoveChild');
- Result:=nil;
- end;
- function TDOMNode.RemoveChild(OldChild: TDOMNode): TDOMNode;
- begin
- Result := DetachChild(OldChild);
- end;
- function TDOMNode.AppendChild(NewChild: TDOMNode): TDOMNode;
- begin
- Result := InsertBefore(NewChild, nil);
- end;
- function TDOMNode.HasChildNodes: Boolean;
- begin
- Result := False;
- end;
- function TDOMNode.CloneNode(deep: Boolean): TDOMNode;
- begin
- Result := CloneNode(deep, FOwnerDocument);
- end;
- function TDOMNode.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
- begin
- // !! CreateFmt() does not set Code property !!
- raise EDOMNotSupported.Create(Format('Cloning/importing of %s is not supported', [ClassName]));
- Result:=nil;
- end;
- function TDOMNode.FindNode(const ANodeName: DOMString): TDOMNode;
- begin
- // FIX: we have no children, hence cannot find anything
- Result := nil;
- end;
- function TDOMNode.GetRevision: Integer;
- begin
- Result := FOwnerDocument.FRevision;
- end;
- function TDOMNode.IsSupported(const Feature, Version: DOMString): Boolean;
- begin
- Result := FOwnerDocument.Impl.HasFeature(Feature, Version);
- end;
- function TDOMNode.HasAttributes: Boolean;
- begin
- Result := False;
- end;
- procedure TDOMNode.Normalize;
- var
- Child, tmp: TDOMNode;
- Txt: TDOMText;
- begin
- Child := FirstChild;
- Txt := nil;
- while Assigned(Child) do
- begin
- if Child.NodeType = TEXT_NODE then
- begin
- tmp := Child.NextSibling;
- if TDOMText(Child).Data <> '' then
- begin
- if Assigned(Txt) then
- begin
- Txt.AppendData(TDOMText(Child).Data);
- // TODO: maybe should be smarter
- Exclude(Txt.FFlags, nfIgnorableWS);
- end
- else
- begin
- Txt := TDOMText(Child);
- Child := Child.NextSibling;
- Continue;
- end;
- end;
- Child.Free;
- Child := tmp;
- end
- else
- begin
- Child.Normalize; // should be recursive!
- Child := Child.NextSibling;
- Txt := nil;
- end;
- end;
- end;
- function TDOMNode.GetTextContent: DOMString;
- begin
- Result := NodeValue;
- end;
- procedure TDOMNode.SetTextContent(const AValue: DOMString);
- begin
- SetNodeValue(AValue);
- end;
- function TDOMNode.GetNamespaceURI: DOMString;
- begin
- Result := '';
- end;
- function TDOMNode.GetLocalName: DOMString;
- begin
- Result := '';
- end;
- function TDOMNode.GetPrefix: DOMString;
- begin
- Result := '';
- end;
- procedure TDOMNode.SetPrefix(const Value: DOMString);
- begin
- // do nothing, override for Elements and Attributes
- end;
- function TDOMNode.GetOwnerDocument: TDOMDocument;
- begin
- Result := FOwnerDocument;
- end;
- procedure TDOMNode.SetReadOnly(Value: Boolean);
- var
- child: TDOMNode;
- attrs: TDOMNamedNodeMap;
- I: Integer;
- begin
- if Value then
- Include(FFlags, nfReadOnly)
- else
- Exclude(FFlags, nfReadOnly);
- child := FirstChild;
- while Assigned(child) do
- begin
- child.SetReadOnly(Value);
- child := child.NextSibling;
- end;
- if HasAttributes then
- begin
- attrs := Attributes;
- for I := 0 to attrs.Length-1 do
- attrs[I].SetReadOnly(Value);
- end;
- end;
- procedure TDOMNode.Changing;
- begin
- if (nfReadOnly in FFlags) and not (nfDestroying in FOwnerDocument.FFlags) then
- raise EDOMError.Create(NO_MODIFICATION_ALLOWED_ERR, 'Node.CheckReadOnly');
- end;
- function CompareDOMStrings(const s1, s2: DOMPChar; l1, l2: integer): integer;
- var i: integer;
- begin
- Result:=l1-l2;
- i:=0;
- while (i<l1) and (Result=0) do begin
- Result:=ord(s1[i])-ord(s2[i]);
- inc(i);
- end;
- end;
- // generic version (slow)
- function TDOMNode.CompareName(const name: DOMString): Integer;
- var
- SelfName: DOMString;
- begin
- SelfName := NodeName;
- Result := CompareDOMStrings(DOMPChar(name), DOMPChar(SelfName), Length(name), Length(SelfName));
- end;
- // This will return nil for Entity, Notation, DocType and DocFragment's
- function GetAncestorElement(n: TDOMNode): TDOMElement;
- var
- parent: TDOMNode;
- begin
- case n.nodeType of
- DOCUMENT_NODE:
- result := TDOMDocument(n).documentElement;
- ATTRIBUTE_NODE:
- result := TDOMAttr(n).OwnerElement;
- else
- parent := n.ParentNode;
- while Assigned(parent) and (parent.NodeType <> ELEMENT_NODE) do
- parent := parent.ParentNode;
- Result := TDOMElement(parent);
- end;
- end;
- // TODO: specs prescribe to return default namespace if APrefix=null,
- // but we aren't able to distinguish null from an empty string.
- // This breaks level3/nodelookupnamespaceuri08 which passes an empty string.
- function TDOMNode.LookupNamespaceURI(const APrefix: DOMString): DOMString;
- var
- Attr: TDOMAttr;
- Map: TDOMNamedNodeMap;
- I: Integer;
- begin
- Result := '';
- if Self = nil then
- Exit;
- if nodeType = ELEMENT_NODE then
- begin
- if (nfLevel2 in FFlags) and (TDOMElement(Self).Prefix = APrefix) then
- begin
- result := Self.NamespaceURI;
- Exit;
- end;
- if HasAttributes then
- begin
- Map := Attributes;
- for I := 0 to Map.Length-1 do
- begin
- Attr := TDOMAttr(Map[I]);
- // should ignore level 1 atts here
- if ((Attr.Prefix = 'xmlns') and (Attr.localName = APrefix)) or
- ((Attr.localName = 'xmlns') and (APrefix = '')) then
- begin
- result := Attr.NodeValue;
- Exit;
- end;
- end
- end;
- end;
- result := GetAncestorElement(Self).LookupNamespaceURI(APrefix);
- end;
- function TDOMNode.LookupPrefix(const nsURI: DOMString): DOMString;
- begin
- Result := '';
- if (nsURI = '') or (Self = nil) then
- Exit;
- if nodeType = ELEMENT_NODE then
- result := TDOMElement(Self).InternalLookupPrefix(nsURI, TDOMElement(Self))
- else
- result := GetAncestorElement(Self).LookupPrefix(nsURI);
- end;
- function TDOMNode.IsDefaultNamespace(const nsURI: DOMString): Boolean;
- var
- Attr: TDOMAttr;
- Map: TDOMNamedNodeMap;
- I: Integer;
- begin
- Result := False;
- if Self = nil then
- Exit;
- if nodeType = ELEMENT_NODE then
- begin
- if TDOMElement(Self).FNSI.PrefixLen = 0 then
- begin
- result := (nsURI = namespaceURI);
- Exit;
- end
- else if HasAttributes then
- begin
- Map := Attributes;
- for I := 0 to Map.Length-1 do
- begin
- Attr := TDOMAttr(Map[I]);
- if Attr.LocalName = 'xmlns' then
- begin
- result := (Attr.Value = nsURI);
- Exit;
- end;
- end;
- end;
- end;
- result := GetAncestorElement(Self).IsDefaultNamespace(nsURI);
- end;
- function GetParentURI(n: TDOMNode): DOMString;
- var
- entity, parent: TDOMNode;
- begin
- parent := n.ParentNode;
- if Assigned(parent) then
- begin
- entity := nil;
- case parent.nodeType of
- ENTITY_NODE:
- entity := parent;
- ENTITY_REFERENCE_NODE:
- if Assigned(n.OwnerDocument.DocType) then
- entity := n.OwnerDocument.DocType.Entities.GetNamedItem(parent.NodeName);
- end;
- if entity = nil then
- result := parent.BaseURI
- else
- { TODO: this will need fix when resource resolving is implemented;
- it should return the URI of actually fetched entity. }
- ResolveRelativeURI(TDOMEntity(entity).FDecl.FURI, TDOMEntity(entity).SystemID, result);
- end
- else
- result := n.OwnerDocument.DocumentURI;
- end;
- function TDOMNode.GetBaseURI: DOMString;
- var
- base: DOMString;
- dtype: TDOMDocumentType;
- ent: TDOMEntity;
- begin
- case NodeType of
- ELEMENT_NODE:
- begin
- result := GetParentURI(Self);
- { 'xml' prefix is restricted to xml namespace, so this will work
- regardless of namespace processing enabled }
- base := TDOMElement(Self).GetAttribute('xml:base');
- if base <> '' then
- begin
- ResolveRelativeUri(result, base, result);
- end;
- end;
- DOCUMENT_NODE:
- result := TDOMDocument(Self).FURI;
- PROCESSING_INSTRUCTION_NODE:
- result := GetParentURI(Self);
- { BaseUri of entities and notations is the URI where they're defined;
- cloning should cause this property to get lost. }
- ENTITY_NODE:
- result := TDOMEntity(Self).FBaseURI;
- NOTATION_NODE:
- result := TDOMNotation(Self).FBaseURI;
- ENTITY_REFERENCE_NODE:
- begin
- result := '';
- dtype := OwnerDocument.DocType;
- if Assigned(dtype) then
- begin
- ent := TDOMEntity(dtype.Entities.GetNamedItem(NodeName));
- if Assigned(ent) then
- result := ent.FDecl.FURI;
- end;
- end
- else
- result := '';
- end;
- end;
- //------------------------------------------------------------------------------
- type
- TNodeTypeEnum = ELEMENT_NODE..NOTATION_NODE;
- TNodeTypeSet = set of TNodeTypeEnum;
- const
- stdChildren = [TEXT_NODE, ENTITY_REFERENCE_NODE, PROCESSING_INSTRUCTION_NODE,
- COMMENT_NODE, CDATA_SECTION_NODE, ELEMENT_NODE];
- ValidChildren: array [TNodeTypeEnum] of TNodeTypeSet = (
- stdChildren, { element }
- [TEXT_NODE, ENTITY_REFERENCE_NODE], { attribute }
- [], { text }
- [], { cdata }
- stdChildren, { ent ref }
- stdChildren, { entity }
- [], { pi }
- [], { comment }
- [ELEMENT_NODE, DOCUMENT_TYPE_NODE, PROCESSING_INSTRUCTION_NODE, COMMENT_NODE], { document }
- [], { doctype }
- stdChildren, { fragment }
- [] { notation }
- );
- function TDOMNode_WithChildren.GetFirstChild: TDOMNode;
- begin
- Result := FFirstChild;
- end;
- function TDOMNode_WithChildren.GetLastChild: TDOMNode;
- begin
- if FFirstChild = nil then
- Result := nil
- else
- Result := FFirstChild.FPreviousSibling;
- end;
- destructor TDOMNode_WithChildren.Destroy;
- begin
- FreeChildren;
- FChildNodes.Free; // its destructor will zero the field
- inherited Destroy;
- end;
- function TDOMNode_WithChildren.InsertBefore(NewChild, RefChild: TDOMNode):
- TDOMNode;
- var
- Tmp: TDOMNode;
- NewChildType: Integer;
- begin
- Result := NewChild;
- NewChildType := NewChild.NodeType;
- Changing;
- if NewChild.FOwnerDocument <> FOwnerDocument then
- begin
- if (NewChildType <> DOCUMENT_TYPE_NODE) or
- (NewChild.FOwnerDocument <> nil) then
- raise EDOMWrongDocument.Create('NodeWC.InsertBefore');
- end;
- if Assigned(RefChild) and (RefChild.ParentNode <> Self) then
- raise EDOMNotFound.Create('NodeWC.InsertBefore');
- // TODO: skip checking Fragments as well? (Fragment itself cannot be in the tree)
- if not (NewChildType in [TEXT_NODE, CDATA_SECTION_NODE, COMMENT_NODE, PROCESSING_INSTRUCTION_NODE]) and (NewChild.FirstChild <> nil) then
- begin
- Tmp := Self;
- while Assigned(Tmp) do
- begin
- if Tmp = NewChild then
- raise EDOMHierarchyRequest.Create('NodeWC.InsertBefore (cycle in tree)');
- Tmp := Tmp.ParentNode;
- end;
- end;
- if NewChild = RefChild then // inserting node before itself is a no-op
- Exit;
- Inc(FOwnerDocument.FRevision); // invalidate nodelists
- if NewChildType = DOCUMENT_FRAGMENT_NODE then
- begin
- Tmp := NewChild.FirstChild;
- if Assigned(Tmp) then
- begin
- while Assigned(Tmp) do
- begin
- if not (Tmp.NodeType in ValidChildren[NodeType]) then
- raise EDOMHierarchyRequest.Create('NodeWC.InsertBefore');
- Tmp := Tmp.NextSibling;
- end;
-
- while Assigned(TDOMDocumentFragment(NewChild).FFirstChild) do
- InsertBefore(TDOMDocumentFragment(NewChild).FFirstChild, RefChild);
- end;
- Exit;
- end;
- if not (NewChildType in ValidChildren[NodeType]) then
- raise EDOMHierarchyRequest.Create('NodeWC.InsertBefore');
- if Assigned(NewChild.FParentNode) then
- NewChild.FParentNode.DetachChild(NewChild);
- NewChild.FNextSibling := RefChild;
- if RefChild = nil then // append to the end
- begin
- if Assigned(FFirstChild) then
- begin
- Tmp := FFirstChild.FPreviousSibling; { our last child }
- Tmp.FNextSibling := NewChild;
- NewChild.FPreviousSibling := Tmp;
- end
- else
- begin
- FFirstChild := NewChild;
- Include(NewChild.FFlags, nfFirstChild);
- end;
- FFirstChild.FPreviousSibling := NewChild; { becomes our last child }
- end
- else // insert before RefChild
- begin
- NewChild.FPreviousSibling := RefChild.FPreviousSibling;
- if RefChild = FFirstChild then
- begin
- Exclude(RefChild.FFlags, nfFirstChild);
- FFirstChild := NewChild;
- Include(NewChild.FFlags, nfFirstChild);
- end
- else
- RefChild.FPreviousSibling.FNextSibling := NewChild;
- RefChild.FPreviousSibling := NewChild;
- end;
- NewChild.FParentNode := Self;
- end;
- function TDOMNode_WithChildren.ReplaceChild(NewChild, OldChild: TDOMNode):
- TDOMNode;
- begin
- InsertBefore(NewChild, OldChild);
- if Assigned(OldChild) and (OldChild <> NewChild) then
- RemoveChild(OldChild);
- Result := OldChild;
- end;
- function TDOMNode_WithChildren.DetachChild(OldChild: TDOMNode): TDOMNode;
- var
- prev, next: TDOMNode;
- begin
- Changing;
- if OldChild.ParentNode <> Self then
- raise EDOMNotFound.Create('NodeWC.RemoveChild');
- Inc(FOwnerDocument.FRevision); // invalidate nodelists
- if OldChild = FFirstChild then
- begin
- Exclude(OldChild.FFlags, nfFirstChild);
- FFirstChild := FFirstChild.FNextSibling;
- if Assigned(FFirstChild) then
- begin
- { maintain lastChild }
- Include(FFirstChild.FFlags, nfFirstChild);
- FFirstChild.FPreviousSibling := OldChild.FPreviousSibling;
- end;
- end
- else
- begin
- prev := OldChild.FPreviousSibling;
- next := OldChild.FNextSibling;
- prev.FNextSibling := next;
- if Assigned(next) then { removing node in the middle }
- next.FPreviousSibling := prev
- else { removing the last child }
- FFirstChild.FPreviousSibling := prev;
- end;
- // Make sure removed child does not contain references to nowhere
- OldChild.FPreviousSibling := nil;
- OldChild.FNextSibling := nil;
- OldChild.FParentNode := nil;
- Result := OldChild;
- end;
- procedure TDOMNode_WithChildren.InternalAppend(NewChild: TDOMNode);
- var
- Tmp: TDOMNode;
- begin
- if Assigned(FFirstChild) then
- begin
- Tmp := FFirstChild.FPreviousSibling; { our last child }
- Tmp.FNextSibling := NewChild;
- NewChild.FPreviousSibling := Tmp;
- end
- else
- begin
- FFirstChild := NewChild;
- Include(NewChild.FFlags, nfFirstChild);
- end;
- FFirstChild.FPreviousSibling := NewChild; { becomes our last child }
- NewChild.FParentNode := Self;
- end;
- function TDOMNode_WithChildren.HasChildNodes: Boolean;
- begin
- Result := Assigned(FFirstChild);
- end;
- function TDOMNode_WithChildren.FindNode(const ANodeName: DOMString): TDOMNode;
- begin
- Result := FFirstChild;
- while Assigned(Result) do
- begin
- if Result.CompareName(ANodeName)=0 then
- Exit;
- Result := Result.NextSibling;
- end;
- end;
- procedure TDOMNode_WithChildren.CloneChildren(ACopy: TDOMNode;
- ACloneOwner: TDOMDocument);
- var
- node: TDOMNode;
- begin
- node := FirstChild;
- while Assigned(node) do
- begin
- TDOMNode_WithChildren(ACopy).InternalAppend(node.CloneNode(True, ACloneOwner));
- node := node.NextSibling;
- end;
- end;
- procedure TDOMNode_WithChildren.FreeChildren;
- var
- child, next: TDOMNode;
- begin
- child := FFirstChild;
- while Assigned(child) do
- begin
- next := child.NextSibling;
- child.FParentNode := nil;
- child.Destroy; // we know it's not nil, so save a call
- child := next;
- end;
- FFirstChild := nil;
- end;
- function TDOMNode_WithChildren.GetTextContent: DOMString;
- var
- child: TDOMNode;
- begin
- Result := '';
- child := FFirstChild;
- // TODO: probably very slow, optimization needed
- while Assigned(child) do
- begin
- case child.NodeType of
- TEXT_NODE: if not (nfIgnorableWS in child.FFlags) then
- Result := Result + TDOMText(child).Data;
- COMMENT_NODE, PROCESSING_INSTRUCTION_NODE: ; // ignored
- else
- Result := Result + child.TextContent;
- end;
- child := child.NextSibling;
- end;
- end;
- procedure TDOMNode_WithChildren.SetTextContent(const AValue: DOMString);
- begin
- Changing;
- while Assigned(FFirstChild) do
- DetachChild(FFirstChild);
- if AValue <> '' then
- AppendChild(FOwnerDocument.CreateTextNode(AValue));
- end;
- // -------------------------------------------------------
- // NodeList
- // -------------------------------------------------------
- constructor TDOMNodeList.Create(ANode: TDOMNode);
- begin
- inherited Create;
- FNode := ANode;
- FRevision := ANode.GetRevision-1; // force BuildList at first access
- FList := TFPList.Create;
- end;
- destructor TDOMNodeList.Destroy;
- begin
- if (FNode is TDOMNode_WithChildren) and
- (TDOMNode_WithChildren(FNode).FChildNodes = Self) then
- TDOMNode_WithChildren(FNode).FChildNodes := nil
- else
- FNode.FOwnerDocument.NodeListDestroyed(Self);
- FList.Free;
- inherited Destroy;
- end;
- function TDOMNodeList.NodeFilter(aNode: TDOMNode): TFilterResult;
- begin
- // accept all nodes but don't allow recursion
- Result := frNorecurseTrue;
- end;
- procedure TDOMNodeList.BuildList;
- var
- current, next: TDOMNode;
- res: TFilterResult;
- begin
- FList.Clear;
- FRevision := FNode.GetRevision; // refresh
- current := FNode.FirstChild;
- while Assigned(current) do
- begin
- res := NodeFilter(current);
- if res in [frTrue, frNorecurseTrue] then
- FList.Add(current);
- next := nil;
- if res in [frTrue, frFalse] then
- next := current.FirstChild;
- if next = nil then
- begin
- while current <> FNode do
- begin
- next := current.NextSibling;
- if Assigned(next) then
- Break;
- current := current.ParentNode;
- end;
- end;
- current := next;
- end;
- end;
- function TDOMNodeList.GetCount: LongWord;
- begin
- if FRevision <> FNode.GetRevision then
- BuildList;
- Result := FList.Count;
- end;
- function TDOMNodeList.GetItem(index: LongWord): TDOMNode;
- begin
- if FRevision <> FNode.GetRevision then
- BuildList;
- if index < LongWord(FList.Count) then
- Result := TDOMNode(FList.List^[index])
- else
- Result := nil;
- end;
- { TDOMElementList }
- constructor TDOMElementList.Create(ANode: TDOMNode; const AFilter: DOMString);
- begin
- inherited Create(ANode);
- filter := AFilter;
- UseFilter := filter <> '*';
- end;
- constructor TDOMElementList.Create(ANode: TDOMNode; const nsURI, localName: DOMString);
- begin
- inherited Create(ANode);
- localNameFilter := localName;
- FMatchNS := True;
- FMatchAnyNS := (nsURI = '*');
- if not FMatchAnyNS then
- FNSIndexFilter := ANode.FOwnerDocument.IndexOfNS(nsURI);
- UseFilter := (localName <> '*');
- end;
- function TDOMElementList.NodeFilter(aNode: TDOMNode): TFilterResult;
- var
- I, L: Integer;
- begin
- Result := frFalse;
- if aNode.NodeType = ELEMENT_NODE then with TDOMElement(aNode) do
- begin
- if FMatchNS then
- begin
- if (FMatchAnyNS or (FNSI.NSIndex = Word(FNSIndexFilter))) then
- begin
- I := FNSI.PrefixLen;
- L := system.Length(FNSI.QName^.Key);
- if (not UseFilter or ((L-I = system.Length(localNameFilter)) and
- CompareMem(@FNSI.QName^.Key[I+1], DOMPChar(localNameFilter), system.Length(localNameFilter)*sizeof(WideChar)))) then
- Result := frTrue;
- end;
- end
- else if (not UseFilter or (TagName = Filter)) then
- Result := frTrue;
- end;
- end;
- // -------------------------------------------------------
- // NamedNodeMap
- // -------------------------------------------------------
- constructor TDOMNamedNodeMap.Create(AOwner: TDOMNode);
- begin
- inherited Create;
- FOwner := AOwner;
- FList := TFPList.Create;
- end;
- destructor TDOMNamedNodeMap.Destroy;
- var
- I: Integer;
- begin
- for I := FList.Count-1 downto 0 do
- TDOMNode(FList.List^[I]).Free;
- FList.Free;
- inherited Destroy;
- end;
- function TDOMNamedNodeMap.GetItem(index: LongWord): TDOMNode;
- begin
- if index < LongWord(FList.Count) then
- Result := TDOMNode(FList.List^[index])
- else
- Result := nil;
- end;
- function TDOMNamedNodeMap.GetLength: LongWord;
- begin
- Result := FList.Count;
- end;
- function TDOMNamedNodeMap.Find(const name: DOMString; out Index: LongWord): Boolean;
- var
- L, H, I, C: Integer;
- begin
- Result := False;
- L := 0;
- H := FList.Count - 1;
- while L <= H do
- begin
- I := (L + H) shr 1;
- C := TDOMNode(FList.List^[I]).CompareName(name);
- if C > 0 then L := I + 1 else
- begin
- H := I - 1;
- if C = 0 then
- begin
- Result := True;
- L := I;
- end;
- end;
- end;
- Index := L;
- end;
- function TDOMNamedNodeMap.GetNamedItem(const name: DOMString): TDOMNode;
- var
- i: Cardinal;
- begin
- if Find(name, i) then
- Result := TDOMNode(FList.List^[i])
- else
- Result := nil;
- end;
- // Note: this *may* raise NOT_SUPPORTED_ERR if the document is e.g. HTML.
- // This isn't checked now.
- function TDOMNamedNodeMap.GetNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode;
- begin
- Result := nil;
- end;
- function TDOMNamedNodeMap.ValidateInsert(arg: TDOMNode): Integer;
- begin
- Result := 0;
- if nfReadOnly in FOwner.FFlags then
- Result := NO_MODIFICATION_ALLOWED_ERR
- else if arg.FOwnerDocument <> FOwner.FOwnerDocument then
- Result := WRONG_DOCUMENT_ERR;
- { Note: Since Entity and Notation maps are always read-only, and the AttributeMap
- overrides this method and does its own check for correct arg.NodeType, there's
- no point in checking NodeType here. }
- end;
- function TDOMNamedNodeMap.SetNamedItem(arg: TDOMNode): TDOMNode;
- var
- i: Cardinal;
- Exists: Boolean;
- res: Integer;
- begin
- res := ValidateInsert(arg);
- if res <> 0 then
- raise EDOMError.Create(res, 'NamedNodeMap.SetNamedItem');
- Exists := Find(arg.NodeName, i);
- if Exists then
- begin
- Result := TDOMNode(FList.List^[i]);
- FList.List^[i] := arg;
- exit;
- end;
- FList.Insert(i, arg);
- Result := nil;
- end;
- function TDOMNamedNodeMap.SetNamedItemNS(arg: TDOMNode): TDOMNode;
- begin
- { Since the map contains only namespaceless nodes (all having empty
- localName and namespaceURI properties), a namespaced arg won't match
- any of them. Therefore, add it using nodeName as key.
- Note: a namespaceless arg is another story, as it will match *any* node
- in the map. This can be considered as a flaw in specs. }
- Result := SetNamedItem(arg);
- end;
- function TDOMNamedNodeMap.Delete(index: LongWord): TDOMNode;
- begin
- Result := TDOMNode(FList.List^[index]);
- FList.Delete(index);
- end;
- function TDOMNamedNodeMap.InternalRemove(const name: DOMString): TDOMNode;
- var
- i: Cardinal;
- begin
- if Find(name, i) then
- Result := Delete(I)
- else
- Result := nil;
- end;
- function TDOMNamedNodeMap.RemoveNamedItem(const name: DOMString): TDOMNode;
- begin
- if nfReadOnly in FOwner.FFlags then
- raise EDOMError.Create(NO_MODIFICATION_ALLOWED_ERR, 'NamedNodeMap.RemoveNamedItem');
- Result := InternalRemove(name);
- if Result = nil then
- raise EDOMNotFound.Create('NamedNodeMap.RemoveNamedItem');
- end;
- function TDOMNamedNodeMap.RemoveNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode;
- begin
- // see comments to SetNamedItemNS. Related tests are written clever enough
- // in the sense they don't expect NO_MODIFICATION_ERR in first place.
- raise EDOMNotFound.Create('NamedNodeMap.RemoveNamedItemNS');
- Result := nil;
- end;
- { TAttributeMap }
- function TAttributeMap.Delete(index: LongWord): TDOMNode;
- begin
- Result := inherited Delete(index);
- if Assigned(Result) then
- begin
- Result.FParentNode := nil;
- if Assigned(TDOMAttr(Result).FNSI.QName) then
- RestoreDefault(TDOMAttr(Result).FNSI.QName);
- end;
- end;
- function TAttributeMap.ValidateInsert(arg: TDOMNode): Integer;
- begin
- Result := inherited ValidateInsert(arg);
- if Result = 0 then
- begin
- if arg.NodeType <> ATTRIBUTE_NODE then
- Result := HIERARCHY_REQUEST_ERR
- else if Assigned(arg.FParentNode) and (arg.FParentNode <> FOwner) then
- Result := INUSE_ATTRIBUTE_ERR;
- end;
- end;
- procedure TAttributeMap.RestoreDefault(aName: PHashItem);
- var
- eldef: TElementDecl;
- attrdef: TAttributeDef;
- begin
- if not Assigned(TDOMElement(FOwner).FNSI.QName) then // safeguard
- Exit;
- eldef := TElementDecl(TDOMElement(FOwner).FNSI.QName^.Data);
- if Assigned(eldef) then
- begin
- // TODO: can be avoided by linking attributes directly to their defs
- attrdef := eldef.GetAttrDef(aName);
- if Assigned(attrdef) and (attrdef.Default in [adDefault, adFixed]) then
- TDOMElement(FOwner).RestoreDefaultAttr(attrdef);
- end;
- end;
- // Since list is kept sorted by nodeName, we must use linear search here.
- // This routine is not called while parsing, so parsing speed is not lowered.
- function TAttributeMap.FindNS(nsIndex: Integer; const aLocalName: DOMString;
- out Index: LongWord): Boolean;
- var
- I: Integer;
- P: DOMPChar;
- begin
- for I := 0 to FList.Count-1 do
- begin
- with TDOMAttr(FList.List^[I]) do
- begin
- if nsIndex = FNSI.NSIndex then
- begin
- P := DOMPChar(FNSI.QName^.Key);
- if FNSI.PrefixLen > 1 then
- Inc(P, FNSI.PrefixLen);
- if CompareDOMStrings(DOMPChar(aLocalName), P, System.Length(aLocalName), System.Length(FNSI.QName^.Key) - FNSI.PrefixLen) = 0 then
- begin
- Index := I;
- Result := True;
- Exit;
- end;
- end;
- end;
- end;
- Result := False;
- end;
- function TAttributeMap.InternalRemoveNS(const nsURI, aLocalName: DOMString): TDOMNode;
- var
- i: Cardinal;
- nsIndex: Integer;
- begin
- Result := nil;
- nsIndex := FOwner.FOwnerDocument.IndexOfNS(nsURI);
- if (nsIndex >= 0) and FindNS(nsIndex, aLocalName, i) then
- Result := Delete(I);
- end;
- function TAttributeMap.getNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode;
- var
- nsIndex: Integer;
- i: LongWord;
- begin
- nsIndex := FOwner.FOwnerDocument.IndexOfNS(namespaceURI);
- if (nsIndex >= 0) and FindNS(nsIndex, localName, i) then
- Result := TDOMNode(FList.List^[i])
- else
- Result := nil;
- end;
- function TAttributeMap.setNamedItem(arg: TDOMNode): TDOMNode;
- begin
- Result := inherited setNamedItem(arg);
- if Assigned(Result) then
- Result.FParentNode := nil;
- arg.FParentNode := FOwner;
- end;
- function TAttributeMap.setNamedItemNS(arg: TDOMNode): TDOMNode;
- var
- i: LongWord;
- res: Integer;
- Exists: Boolean;
- begin
- res := ValidateInsert(arg);
- if res <> 0 then
- raise EDOMError.Create(res, 'NamedNodeMap.SetNamedItemNS');
- Result := nil;
- with TDOMAttr(arg) do
- begin
- // calling LocalName is no good... but it is done once
- if FindNS(FNSI.NSIndex, localName, i) then
- begin
- Result := TDOMNode(FList.List^[i]);
- FList.Delete(i);
- end;
- // Do a non-namespace search in order to keep the list sorted on nodeName
- Exists := Find(FNSI.QName^.Key, i);
- if Exists and (Result = nil) then // case when arg has no namespace
- begin
- Result := TDOMNode(FList.List^[i]);
- FList.List^[i] := arg;
- end
- else
- FList.Insert(i, arg);
- end;
- if Assigned(Result) then
- Result.FParentNode := nil;
- arg.FParentNode := FOwner;
- end;
- function TAttributeMap.removeNamedItemNS(const namespaceURI,
- localName: DOMString): TDOMNode;
- begin
- if nfReadOnly in FOwner.FFlags then
- raise EDOMError.Create(NO_MODIFICATION_ALLOWED_ERR, 'NamedNodeMap.RemoveNamedItemNS');
- Result := InternalRemoveNS(namespaceURI, localName);
- if Result = nil then
- raise EDOMNotFound.Create('NamedNodeMap.RemoveNamedItemNS');
- end;
- // -------------------------------------------------------
- // CharacterData
- // -------------------------------------------------------
- function TDOMCharacterData.GetLength: LongWord;
- begin
- Result := system.Length(FNodeValue);
- end;
- function TDOMCharacterData.GetNodeValue: DOMString;
- begin
- Result := FNodeValue;
- end;
- procedure TDOMCharacterData.SetNodeValue(const AValue: DOMString);
- begin
- Changing;
- FNodeValue := AValue;
- end;
- function TDOMCharacterData.SubstringData(offset, count: LongWord): DOMString;
- begin
- if offset > Length then
- raise EDOMIndexSize.Create('CharacterData.SubstringData');
- Result := Copy(FNodeValue, offset + 1, count);
- end;
- procedure TDOMCharacterData.AppendData(const arg: DOMString);
- begin
- Changing;
- FNodeValue := FNodeValue + arg;
- end;
- procedure TDOMCharacterData.InsertData(offset: LongWord; const arg: DOMString);
- begin
- Changing;
- if offset > Length then
- raise EDOMIndexSize.Create('CharacterData.InsertData');
- Insert(arg, FNodeValue, offset+1);
- end;
- procedure TDOMCharacterData.DeleteData(offset, count: LongWord);
- begin
- Changing;
- if offset > Length then
- raise EDOMIndexSize.Create('CharacterData.DeleteData');
- Delete(FNodeValue, offset+1, count);
- end;
- procedure TDOMCharacterData.ReplaceData(offset, count: LongWord; const arg: DOMString);
- begin
- DeleteData(offset, count);
- InsertData(offset, arg);
- end;
- // -------------------------------------------------------
- // DocumentFragmet
- // -------------------------------------------------------
- function TDOMDocumentFragment.GetNodeType: Integer;
- begin
- Result := DOCUMENT_FRAGMENT_NODE;
- end;
- function TDOMDocumentFragment.GetNodeName: DOMString;
- begin
- Result := '#document-fragment';
- end;
- function TDOMDocumentFragment.CloneNode(deep: Boolean; aCloneOwner: TDOMDocument): TDOMNode;
- begin
- Result := aCloneOwner.CreateDocumentFragment;
- if deep then
- CloneChildren(Result, aCloneOwner);
- end;
- // -------------------------------------------------------
- // Top-level node
- // -------------------------------------------------------
- function TDOMNode_TopLevel.GetXMLVersion: DOMString;
- begin
- Result := xmlVersionStr[FXMLVersion];
- end;
- // -------------------------------------------------------
- // 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): Integer;
- var
- I, L: Integer;
- begin
- if not IsXmlName(QName) then
- begin
- Result := -INVALID_CHARACTER_ERR;
- Exit;
- end;
- L := Length(QName);
- Result := Pos(WideChar(':'), QName);
- if Result > 0 then
- begin
- for I := Result+1 to L-1 do // check for second colon (Use IndexWord?)
- if QName[I] = ':' then
- begin
- Result := -NAMESPACE_ERR;
- Exit;
- end;
- // Name validity has already been checked by IsXmlName() call above.
- // So just check that colon isn't first or last char, and that it is follwed by NameStartChar.
- if ((Result = 1) or (Result = L) or not IsXmlName(@QName[Result+1], 1)) then
- begin
- Result := -NAMESPACE_ERR;
- Exit;
- end;
- end;
- if nsIdx < 0 then Exit;
- // QName contains prefix, but no namespace
- if ((nsIdx = 0) and (Result > 0)) or
- // Bad usage of 'http://www.w3.org/2000/xmlns/'
- ((((L = 5) or (Result = 6)) and (Pos(DOMString('xmlns'), QName) = 1)) <> (nsIdx = 2)) or
- // Bad usage of 'http://www.w3.org/XML/1998/namespace'
- ((Result = 4) and (Pos(DOMString('xml'), QName) = 1) and (nsIdx <> 1)) then
- Result := -NAMESPACE_ERR;
- end;
- function TDOMImplementation.HasFeature(const feature, version: DOMString):
- Boolean;
- var
- s: string;
- begin
- s := feature; // force Ansi, features do not contain non-ASCII chars
- Result := (SameText(s, 'XML') and ((version = '') or (version = '1.0') or (version = '2.0'))) or
- (SameText(s, 'Core') and ((version = '') or (version = '2.0')));
- end;
- function TDOMImplementation.CreateDocumentType(const QualifiedName, PublicID,
- SystemID: DOMString): TDOMDocumentType;
- var
- res: Integer;
- model: TDTDModel;
- begin
- res := CheckQName(QualifiedName, -1);
- if res < 0 then
- raise EDOMError.Create(-res, 'Implementation.CreateDocumentType');
- model := TDTDModel.Create(nil); // !!nowhere to get nametable from at this time
- model.FName := QualifiedName;
- // DOM does not restrict PublicID without SystemID (unlike XML spec)
- model.FPublicID := PublicID;
- model.FSystemID := SystemID;
- Result := TDOMDocumentType.Create(nil, model);
- model.Release; // now Result remains a sole owner of model
- end;
- function TDOMImplementation.CreateDocument(const NamespaceURI,
- QualifiedName: DOMString; doctype: TDOMDocumentType): TDOMDocument;
- var
- Root: TDOMNode;
- begin
- if Assigned(doctype) and Assigned(doctype.OwnerDocument) then
- raise EDOMWrongDocument.Create('Implementation.CreateDocument');
- Result := TXMLDocument.Create;
- Result.FImplementation := Self;
- try
- if Assigned(doctype) then
- begin
- Doctype.FOwnerDocument := Result;
- Result.AppendChild(doctype);
- end;
- Root := Result.CreateElementNS(NamespaceURI, QualifiedName);
- Result.AppendChild(Root);
- except
- Result.Free;
- raise;
- end;
- end;
- // -------------------------------------------------------
- // Document
- // -------------------------------------------------------
- constructor TDOMDocument.Create;
- begin
- inherited Create(nil);
- FOwnerDocument := Self;
- FMaxPoolSize := (TDOMEntity.InstanceSize + sizeof(Pointer)-1) and not (sizeof(Pointer)-1) + sizeof(Pointer);
- FPools := AllocMem(FMaxPoolSize);
- FNames := THashTable.Create(256, True);
- SetLength(FNamespaces, 3);
- // Namespace #0 should always be an empty string
- FNamespaces[1] := stduri_xml;
- FNamespaces[2] := stduri_xmlns;
- FEmptyNode := TDOMElement.Create(Self);
- end;
- destructor TDOMDocument.Destroy;
- var
- i: Integer;
- begin
- Include(FFlags, nfDestroying);
- FreeAndNil(FIDList); // set to nil before starting destroying children
- FNodeLists.Free;
- FEmptyNode.Free;
- inherited Destroy;
- for i := 0 to (FMaxPoolSize div sizeof(TNodePool))-1 do
- FPools^[i].Free;
- FreeMem(FPools);
- FNames.Free; // free the nametable after inherited has destroyed the children
- // (because children reference the nametable)
- end;
- function TDOMDocument.CloneNode(deep: Boolean): TDOMNode;
- type
- TDOMDocumentClass = class of TDOMDocument;
- var
- Clone: TDOMDocument;
- node, doctypenode: TDOMNode;
- begin
- Clone := TDOMDocumentClass(ClassType).Create;
- Clone.FInputEncoding := FInputEncoding;
- Clone.FXMLEncoding := FXMLEncoding;
- Clone.FXMLVersion := FXMLVersion;
- Clone.FXMLStandalone := FXMLStandalone;
- Clone.FURI := FURI;
- if deep then
- begin
- node := FirstChild;
- doctypenode := DocType;
- while Assigned(node) do
- begin
- {TODO: now just skip doctype, a better solution is to be found.}
- if node <> doctypenode then
- Clone.InternalAppend(node.CloneNode(True, Clone));
- node := node.NextSibling;
- end;
- end;
- Result := Clone;
- end;
- function TDOMDocument.Alloc(AClass: TDOMNodeClass): TDOMNode;
- var
- pp: TNodePool;
- size: Integer;
- begin
- if nfDestroying in FFlags then
- raise EDOMError.Create(INVALID_ACCESS_ERR, 'Attempt to allocate node memory while destroying');
- size := (AClass.InstanceSize + sizeof(Pointer)-1) and not (sizeof(Pointer)-1);
- if size > FMaxPoolSize then
- begin
- Result := TDOMNode(AClass.NewInstance);
- Exit;
- end;
- pp := FPools^[size div sizeof(TNodePool)];
- if pp = nil then
- begin
- pp := TNodePool.Create(size);
- FPools^[size div sizeof(TNodePool)] := pp;
- end;
- Result := pp.AllocNode(AClass);
- end;
- // This shouldn't be called if document has no IDs,
- // or when it is being destroyed
- // TODO: This could be much faster if removing ID happens
- // upon modification of corresponding attribute value.
- procedure TDOMDocument.RemoveID(Elem: TDOMElement);
- begin
- FIDList.RemoveData(Elem);
- end;
- function TDOMDocument.GetNodeType: Integer;
- begin
- Result := DOCUMENT_NODE;
- end;
- function TDOMDocument.GetNodeName: DOMString;
- begin
- Result := '#document';
- end;
- function TDOMDocument.GetTextContent: DOMString;
- begin
- Result := '';
- end;
- procedure TDOMDocument.SetTextContent(const value: DOMString);
- begin
- // Document ignores setting TextContent
- end;
- function TDOMDocument.GetOwnerDocument: TDOMDocument;
- begin
- Result := nil;
- end;
- function TDOMDocument.InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode;
- var
- nType: Integer;
- begin
- nType := NewChild.NodeType;
- if ((nType = ELEMENT_NODE) and Assigned(DocumentElement)) or
- ((nType = DOCUMENT_TYPE_NODE) and Assigned(DocType)) then
- raise EDOMHierarchyRequest.Create('Document.InsertBefore');
- Result := inherited InsertBefore(NewChild, RefChild);
- end;
- function TDOMDocument.ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode;
- var
- nType: Integer;
- begin
- nType := NewChild.NodeType;
- if ((nType = ELEMENT_NODE) and (OldChild = DocumentElement)) or // root can be replaced by another element
- ((nType = DOCUMENT_TYPE_NODE) and (OldChild = DocType)) then // and so can be DTD
- begin
- inherited InsertBefore(NewChild, OldChild);
- Result := OldChild;
- if OldChild <> NewChild then
- RemoveChild(OldChild);
- end
- else
- Result := inherited ReplaceChild(NewChild, OldChild);
- end;
- function TDOMDocument.GetDocumentElement: TDOMElement;
- var
- node: TDOMNode;
- begin
- node := FFirstChild;
- while Assigned(node) and (node.NodeType <> ELEMENT_NODE) do
- node := node.NextSibling;
- Result := TDOMElement(node);
- end;
- function TDOMDocument.GetDocType: TDOMDocumentType;
- var
- node: TDOMNode;
- begin
- node := FFirstChild;
- while Assigned(node) and (node.NodeType <> DOCUMENT_TYPE_NODE) do
- node := node.NextSibling;
- Result := TDOMDocumentType(node);
- end;
- function TDOMDocument.CreateElement(const tagName: DOMString): TDOMElement;
- begin
- if not IsXmlName(tagName) then
- raise EDOMError.Create(INVALID_CHARACTER_ERR, 'DOMDocument.CreateElement');
- TDOMNode(Result) := Alloc(TDOMElement);
- Result.Create(Self);
- Result.FNSI.QName := FNames.FindOrAdd(DOMPChar(tagName), Length(tagName));
- Result.AttachDefaultAttrs;
- end;
- function TDOMDocument.CreateElementBuf(Buf: DOMPChar; Length: Integer): TDOMElement;
- begin
- TDOMNode(Result) := Alloc(TDOMElement);
- Result.Create(Self);
- Result.FNSI.QName := FNames.FindOrAdd(Buf, Length);
- end;
- function TDOMDocument.CreateDocumentFragment: TDOMDocumentFragment;
- begin
- TDOMNode(Result) := Alloc(TDOMDocumentFragment);
- Result.Create(Self);
- end;
- function TDOMDocument.CreateTextNode(const data: DOMString): TDOMText;
- begin
- TDOMNode(Result) := Alloc(TDOMText);
- Result.Create(Self);
- Result.FNodeValue := data;
- end;
- function TDOMDocument.CreateTextNodeBuf(Buf: DOMPChar; Length: Integer; IgnWS: Boolean): TDOMText;
- begin
- TDOMNode(Result) := Alloc(TDOMText);
- Result.Create(Self);
- SetString(Result.FNodeValue, Buf, Length);
- if IgnWS then
- Include(Result.FFlags, nfIgnorableWS);
- end;
- function TDOMDocument.CreateComment(const data: DOMString): TDOMComment;
- begin
- TDOMNode(Result) := Alloc(TDOMComment);
- Result.Create(Self);
- Result.FNodeValue := data;
- end;
- function TDOMDocument.CreateCommentBuf(Buf: DOMPChar; Length: Integer): TDOMComment;
- begin
- TDOMNode(Result) := Alloc(TDOMComment);
- Result.Create(Self);
- SetString(Result.FNodeValue, Buf, Length);
- end;
- function TDOMDocument.CreateCDATASection(const data: DOMString):
- TDOMCDATASection;
- begin
- raise EDOMNotSupported.Create('DOMDocument.CreateCDATASection');
- Result:=nil;
- end;
- function TDOMDocument.CreateProcessingInstruction(const target,
- data: DOMString): TDOMProcessingInstruction;
- begin
- raise EDOMNotSupported.Create('DOMDocument.CreateProcessingInstruction');
- Result:=nil;
- end;
- function TDOMDocument.CreateAttribute(const name: DOMString): TDOMAttr;
- begin
- if not IsXmlName(name) then
- raise EDOMError.Create(INVALID_CHARACTER_ERR, 'DOMDocument.CreateAttribute');
- TDOMNode(Result) := Alloc(TDOMAttr);
- Result.Create(Self);
- Result.FNSI.QName := FNames.FindOrAdd(DOMPChar(name), Length(name));
- Include(Result.FFlags, nfSpecified);
- end;
- function TDOMDocument.CreateAttributeBuf(Buf: DOMPChar; Length: Integer): TDOMAttr;
- begin
- TDOMNode(Result) := Alloc(TDOMAttr);
- Result.Create(Self);
- Result.FNSI.QName := FNames.FindOrAdd(buf, Length);
- Include(Result.FFlags, nfSpecified);
- end;
- function TDOMDocument.CreateEntityReference(const name: DOMString):
- TDOMEntityReference;
- begin
- raise EDOMNotSupported.Create('DOMDocument.CreateEntityReference');
- Result:=nil;
- end;
- function TDOMDocument.GetChildNodeList(aNode: TDOMNode): TDOMNodeList;
- begin
- if not (aNode is TDOMNode_WithChildren) then
- aNode := FEmptyNode;
- Result := TDOMNode_WithChildren(aNode).FChildNodes;
- if Result = nil then
- begin
- Result := TDOMNodeList.Create(aNode);
- TDOMNode_WithChildren(aNode).FChildNodes := Result;
- end;
- end;
- function TDOMDocument.GetElementList(aNode: TDOMNode; const nsURI, aLocalName: DOMString;
- UseNS: Boolean): TDOMNodeList;
- var
- L: Integer;
- Key, P: DOMPChar;
- Item: PHashItem;
- begin
- if FNodeLists = nil then
- FNodeLists := THashTable.Create(32, True);
- L := (sizeof(Pointer) div sizeof(WideChar)) + Length(aLocalName);
- if UseNS then
- Inc(L, Length(nsURI)+1);
- GetMem(Key, L*sizeof(WideChar));
- try
- // compose the key for hashing
- P := Key;
- PPointer(P)^ := aNode;
- Inc(PPointer(P));
- Move(DOMPChar(aLocalName)^, P^, Length(aLocalName)*sizeof(WideChar));
- if UseNS then
- begin
- Inc(P, Length(aLocalName));
- P^ := #12; Inc(P); // separator -- diff ('foo','bar') from 'foobar'
- Move(DOMPChar(nsURI)^, P^, Length(nsURI)*sizeof(WideChar));
- end;
- // try finding in the hashtable
- Item := FNodeLists.FindOrAdd(Key, L);
- Result := TDOMNodeList(Item^.Data);
- if Result = nil then
- begin
- if UseNS then
- Result := TDOMElementList.Create(aNode, nsURI, aLocalName)
- else
- Result := TDOMElementList.Create(aNode, aLocalName);
- Item^.Data := Result;
- end;
- finally
- FreeMem(Key);
- end;
- end;
- function TDOMDocument.GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
- begin
- Result := GetElementList(Self, '', tagname, False);
- end;
- function TDOMDocument.GetElementsByTagNameNS(const nsURI, aLocalName: DOMString): TDOMNodeList;
- begin
- Result := GetElementList(Self, nsURI, aLocalName, True);
- end;
- { This is linear hence slow. However:
- - if user code frees each nodelist ASAP, there are only few items in the hashtable
- - if user code does not free nodelists, this is not called at all.
- }
- procedure TDOMDocument.NodeListDestroyed(aList: TDOMNodeList);
- begin
- if (not (nfDestroying in FFlags)) and (FNodeLists <> nil) then
- FNodeLists.RemoveData(aList);
- end;
- function TDOMDocument.CreateAttributeNS(const nsURI,
- QualifiedName: DOMString): TDOMAttr;
- var
- idx, PrefIdx: Integer;
- begin
- idx := IndexOfNS(nsURI, True);
- PrefIdx := CheckQName(QualifiedName, idx);
- 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);
- 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;
- procedure TDOMDocument.SetXMLVersion(const aValue: DOMString);
- begin
- raise EDOMNotSupported.Create('DOMDocument.SetXMLVersion');
- end;
- procedure TDOMDocument.SetXMLStandalone(aValue: Boolean);
- begin
- raise EDOMNotSupported.Create('DOMDocument.SetXMLStandalone');
- end;
- constructor TXMLDocument.Create;
- begin
- inherited Create;
- FXMLVersion := xmlVersion10;
- end;
- function TXMLDocument.CreateCDATASection(const data: DOMString):
- TDOMCDATASection;
- begin
- TDOMNode(Result) := Alloc(TDOMCDATASection);
- Result.Create(Self);
- Result.FNodeValue := data;
- end;
- function TXMLDocument.CreateProcessingInstruction(const target,
- data: DOMString): TDOMProcessingInstruction;
- begin
- if not IsXmlName(target) then
- raise EDOMError.Create(INVALID_CHARACTER_ERR, 'XMLDocument.CreateProcessingInstruction');
- TDOMNode(Result) := Alloc(TDOMProcessingInstruction);
- Result.Create(Self);
- Result.FTarget := target;
- Result.FNodeValue := data;
- end;
- function TXMLDocument.CreateEntityReference(const name: DOMString):
- TDOMEntityReference;
- var
- dType: TDOMDocumentType;
- ent: TDOMEntity;
- begin
- if not IsXmlName(name) then
- raise EDOMError.Create(INVALID_CHARACTER_ERR, 'XMLDocument.CreateEntityReference');
- TDOMNode(Result) := Alloc(TDOMEntityReference);
- Result.Create(Self);
- Result.FName := name;
- dType := DocType;
- if Assigned(dType) then
- begin
- TDOMNode(ent) := dType.Entities.GetNamedItem(name);
- if Assigned(ent) then
- ent.CloneChildren(Result, Self);
- end;
- Result.SetReadOnly(True);
- end;
- procedure TXMLDocument.SetXMLVersion(const aValue: DOMString);
- begin
- if aValue = '1.0' then
- FXMLVersion := xmlVersion10
- else if aValue = '1.1' then
- FXMLVersion := xmlVersion11
- else
- raise EDOMNotSupported.Create('XMLDocument.SetXMLVersion');
- end;
- procedure TXMLDocument.SetXMLStandalone(aValue: Boolean);
- begin
- FXmlStandalone := aValue;
- end;
- { TDOMNode_NS }
- function TDOMNode_NS.GetNodeName: DOMString;
- begin
- // Because FNSI.QName is not set by the TDOMNode itself, but is set by
- // other classes/functions, it is necessary to check if FNSQ.QName is
- // assigned.
- if assigned(FNSI.QName) then
- Result := FNSI.QName^.Key
- else
- Result := '';
- end;
- function TDOMNode_NS.GetLocalName: DOMString;
- begin
- if nfLevel2 in FFlags then
- Result := Copy(FNSI.QName^.Key, FNSI.PrefixLen+1, MaxInt)
- else
- Result := '';
- end;
- function TDOMNode_NS.GetNamespaceURI: DOMString;
- begin
- Result := FOwnerDocument.FNamespaces[FNSI.NSIndex];
- end;
- function TDOMNode_NS.GetPrefix: DOMString;
- begin
- if FNSI.PrefixLen < 2 then
- Result := ''
- else
- Result := Copy(FNSI.QName^.Key, 1, FNSI.PrefixLen-1);
- end;
- procedure TDOMNode_NS.SetPrefix(const Value: DOMString);
- var
- NewName: DOMString;
- begin
- Changing;
- if not IsXmlName(Value) then
- raise EDOMError.Create(INVALID_CHARACTER_ERR, 'Node.SetPrefix');
- if (Pos(WideChar(':'), Value) > 0) or 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;
- function TDOMAttr.GetParentNode: TDOMNode;
- begin
- Result := nil;
- end;
- destructor TDOMAttr.Destroy;
- begin
- if Assigned(FParentNode) and not (nfDestroying in FParentNode.FFlags) then
- // TODO: This may raise NOT_FOUND_ERR in case something's really wrong
- TDOMElement(FParentNode).RemoveAttributeNode(Self);
- FParentNode := nil;
- inherited Destroy;
- end;
- function TDOMAttr.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
- begin
- // Cloned attribute is always specified and carries its children
- if nfLevel2 in FFlags then
- Result := ACloneOwner.CreateAttributeNS(namespaceURI, NodeName)
- else
- Result := ACloneOwner.CreateAttribute(NodeName);
- TDOMAttr(Result).FDataType := FDataType;
- CloneChildren(Result, ACloneOwner);
- end;
- function TDOMAttr.GetNodeValue: DOMString;
- begin
- Result := GetTextContent;
- if FDataType <> dtCdata then
- NormalizeSpaces(Result);
- end;
- procedure TDOMAttr.SetNodeValue(const AValue: DOMString);
- begin
- SetTextContent(AValue);
- Include(FFlags, nfSpecified);
- end;
- function TDOMAttr.GetSpecified: Boolean;
- begin
- Result := nfSpecified in FFlags;
- end;
- function TDOMAttr.GetIsID: Boolean;
- begin
- Result := FDataType = dtID;
- end;
- function TDOMAttr.GetOwnerElement: TDOMElement;
- begin
- Result := TDOMElement(FParentNode);
- end;
- // -------------------------------------------------------
- // Element
- // -------------------------------------------------------
- function TDOMElement.GetNodeType: Integer;
- begin
- Result := ELEMENT_NODE;
- end;
- destructor TDOMElement.Destroy;
- begin
- Include(FFlags, nfDestroying);
- if Assigned(FOwnerDocument.FIDList) then
- FOwnerDocument.RemoveID(Self);
- FAttributes.Free;
- FAttributes := nil;
- inherited Destroy;
- end;
- function TDOMElement.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
- var
- i: Integer;
- Attr, AttrClone: TDOMAttr;
- begin
- if ACloneOwner <> FOwnerDocument then
- begin
- // Importing has to go the hard way...
- if nfLevel2 in FFlags then
- Result := ACloneOwner.CreateElementNS(NamespaceURI, NodeName)
- else
- Result := ACloneOwner.CreateElement(NodeName);
- if Assigned(FAttributes) then
- begin
- for i := 0 to FAttributes.Length - 1 do
- begin
- Attr := TDOMAttr(FAttributes[i]);
- // destroy defaulted attributes (if any), it is safe because caller had not seen them yet
- if Attr.Specified then
- TDOMElement(Result).SetAttributeNode(TDOMAttr(Attr.CloneNode(True, ACloneOwner))).Free;
- end;
- end;
- end
- else // Cloning may cheat a little bit.
- begin
- Result := FOwnerDocument.Alloc(TDOMElement);
- TDOMElement(Result).Create(FOwnerDocument);
- TDOMElement(Result).FNSI := FNSI;
- if nfLevel2 in FFlags then
- Include(Result.FFlags, nfLevel2);
- if Assigned(FAttributes) then
- begin
- // clone all attributes, but preserve nfSpecified flag
- for i := 0 to FAttributes.Length - 1 do
- begin
- Attr := TDOMAttr(FAttributes[i]);
- AttrClone := TDOMAttr(Attr.CloneNode(True, ACloneOwner));
- if not Attr.Specified then
- Exclude(AttrClone.FFlags, nfSpecified);
- TDOMElement(Result).SetAttributeNode(AttrClone);
- end;
- end;
- end;
- if deep then
- CloneChildren(Result, ACloneOwner);
- end;
- procedure TDOMElement.AttachDefaultAttrs;
- var
- eldef: TElementDecl;
- attrdef: TAttributeDef;
- I: Integer;
- begin
- if not Assigned(FNSI.QName) then // safeguard
- Exit;
- eldef := TElementDecl(FNSI.QName^.Data);
- if Assigned(eldef) and eldef.NeedsDefaultPass then
- begin
- for I := 0 to eldef.AttrDefCount-1 do
- begin
- attrdef := eldef.AttrDefs[I];
- if attrdef.Default in [adDefault, adFixed] then
- RestoreDefaultAttr(attrdef);
- end;
- end;
- end;
- function TDOMElement.InternalLookupPrefix(const nsURI: DOMString; Original: TDOMElement): DOMString;
- var
- I: Integer;
- Attr: TDOMAttr;
- begin
- result := '';
- if Self = nil then
- Exit;
- if (nfLevel2 in FFlags) and (namespaceURI = nsURI) and (FNSI.PrefixLen > 0) then
- begin
- Result := Prefix;
- if Original.LookupNamespaceURI(result) = nsURI then
- Exit;
- end;
- if Assigned(FAttributes) then
- begin
- for I := 0 to FAttributes.Length-1 do
- begin
- Attr := TDOMAttr(FAttributes[I]);
- if (Attr.Prefix = 'xmlns') and (Attr.Value = nsURI) then
- begin
- result := Attr.LocalName;
- if Original.LookupNamespaceURI(result) = nsURI then
- Exit;
- end;
- end;
- end;
- result := GetAncestorElement(Self).InternalLookupPrefix(nsURI, Original);
- end;
- function LoadAttribute(doc: TDOMDocument; src: PNodeData): TDOMAttr;
- var
- curr: PNodeData;
- begin
- TDOMNode(result) := doc.Alloc(TDOMAttr);
- result.Create(doc);
- result.FNSI.QName := src^.FQName;
- if not src^.FIsDefault then
- Include(result.FFlags, nfSpecified);
- if Assigned(src^.FTypeInfo) then
- result.FDataType := TAttributeDef(src^.FTypeInfo).DataType;
- if Assigned(src^.FNsUri) then
- result.SetNSI(src^.FNsUri^.Key, src^.FColonPos+1);
- if Assigned(src^.FNext) then
- begin
- curr := src^.FNext;
- while Assigned(curr) do
- begin
- case curr^.FNodeType of
- ntText: result.InternalAppend(doc.CreateTextNode(curr^.FValueStr));
- ntEntityReference: result.InternalAppend(doc.CreateEntityReference(curr^.FQName^.Key));
- end;
- curr := curr^.FNext;
- end;
- end
- else if src^.FValueStr <> '' then
- result.InternalAppend(doc.CreateTextNode(src^.FValueStr));
- end;
- function LoadElement(doc: TDOMDocument; src: PNodeData; attrCount: Integer): TDOMElement;
- var
- i: Integer;
- begin
- TDOMNode(result) := doc.Alloc(TDOMElement);
- result.Create(doc);
- result.FNSI.QName := src^.FQName;
- if Assigned(src^.FNsUri) then
- result.SetNSI(src^.FNsUri^.Key, src^.FColonPos+1);
- for i := 0 to attrCount-1 do
- begin
- Inc(src);
- result.SetAttributeNode(LoadAttribute(doc, src));
- // Attach element to ID map entry if necessary
- if Assigned(src^.FIDEntry) then
- src^.FIDEntry^.Data := Result;
- end;
- end;
- procedure TDOMElement.RestoreDefaultAttr(AttrDef: TAttributeDef);
- var
- Attr: TDOMAttr;
- ColonPos: Integer;
- AttrName, nsuri: DOMString;
- begin
- if nfDestroying in FOwnerDocument.FFlags then
- Exit;
- Attr := LoadAttribute(FOwnerDocument, AttrDef.Data);
- 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);
- Result := FAttributes;
- end;
- function TDOMElement.GetAttribute(const name: DOMString): DOMString;
- var
- Attr: TDOMNode;
- begin
- SetLength(Result, 0);
- if Assigned(FAttributes) then
- begin
- Attr := FAttributes.GetNamedItem(name);
- if Assigned(Attr) then
- Result := Attr.NodeValue;
- end;
- end;
- function TDOMElement.GetAttributeNS(const nsURI, aLocalName: DOMString): DOMString;
- var
- Attr: TDOMNode;
- begin
- SetLength(Result, 0);
- if Assigned(FAttributes) then
- begin
- Attr := FAttributes.GetNamedItemNS(nsURI, aLocalName);
- if Assigned(Attr) then
- Result := Attr.NodeValue;
- end;
- end;
- procedure TDOMElement.SetAttribute(const name, value: DOMString);
- var
- I: Cardinal;
- attr: TDOMAttr;
- begin
- Changing;
- if Attributes.Find(name, I) then
- Attr := FAttributes[I] as TDOMAttr
- else
- begin
- Attr := FOwnerDocument.CreateAttribute(name);
- Attr.FParentNode := Self;
- FAttributes.FList.Insert(I, Attr);
- end;
- attr.NodeValue := value;
- end;
- procedure TDOMElement.RemoveAttribute(const name: DOMString);
- begin
- Changing;
- // (note) NamedNodeMap.RemoveNamedItem can raise NOT_FOUND_ERR and we should not.
- if Assigned(FAttributes) then
- FAttributes.InternalRemove(name).Free;
- end;
- procedure TDOMElement.RemoveAttributeNS(const nsURI,
- aLocalName: DOMString);
- begin
- Changing;
- if Assigned(FAttributes) then
- TAttributeMap(FAttributes).InternalRemoveNS(nsURI, aLocalName).Free;
- end;
- procedure TDOMElement.SetAttributeNS(const nsURI, qualifiedName,
- value: DOMString);
- var
- I: Cardinal;
- Attr: TDOMAttr;
- idx, prefIdx: Integer;
- begin
- Changing;
- idx := FOwnerDocument.IndexOfNS(nsURI, True);
- prefIdx := CheckQName(qualifiedName, idx);
- if prefIdx < 0 then
- raise EDOMError.Create(-prefIdx, 'Element.SetAttributeNS');
- if TAttributeMap(Attributes).FindNS(idx, Copy(qualifiedName, prefIdx+1, MaxInt), I) then
- begin
- Attr := TDOMAttr(FAttributes[I]);
- // need to reinsert because the nodeName may change
- FAttributes.FList.Delete(I);
- end
- else
- begin
- TDOMNode(Attr) := FOwnerDocument.Alloc(TDOMAttr);
- Attr.Create(FOwnerDocument);
- Attr.FParentNode := Self;
- Attr.FNSI.NSIndex := Word(idx);
- Include(Attr.FFlags, nfLevel2);
- end;
- // keep list sorted by DOM Level 1 name
- FAttributes.Find(qualifiedName, I);
- FAttributes.FList.Insert(I, Attr);
- // TODO: rehash properly, same issue as with Node.SetPrefix()
- Attr.FNSI.QName := FOwnerDocument.FNames.FindOrAdd(DOMPChar(qualifiedName), Length(qualifiedName));
- Attr.FNSI.PrefixLen := Word(prefIdx);
- attr.NodeValue := value;
- end;
- function TDOMElement.GetAttributeNode(const name: DOMString): TDOMAttr;
- begin
- if Assigned(FAttributes) then
- Result := FAttributes.GetNamedItem(name) as TDOMAttr
- else
- Result := nil;
- end;
- function TDOMElement.GetAttributeNodeNS(const nsURI, aLocalName: DOMString): TDOMAttr;
- begin
- if Assigned(FAttributes) then
- Result := FAttributes.GetNamedItemNS(nsURI, aLocalName) as TDOMAttr
- else
- Result := nil;
- end;
- function TDOMElement.SetAttributeNode(NewAttr: TDOMAttr): TDOMAttr;
- begin
- Result := Attributes.SetNamedItem(NewAttr) as TDOMAttr;
- end;
- function TDOMElement.SetAttributeNodeNS(NewAttr: TDOMAttr): TDOMAttr;
- begin
- Result := Attributes.SetNamedItemNS(NewAttr) as TDOMAttr;
- end;
- function TDOMElement.RemoveAttributeNode(OldAttr: TDOMAttr): TDOMAttr;
- var
- Index: Integer;
- begin
- Changing;
- Result := OldAttr;
- if Assigned(FAttributes) then
- begin
- Index := FAttributes.FList.IndexOf(OldAttr);
- if Index > -1 then
- begin
- FAttributes.Delete(Index);
- Exit;
- end;
- end;
- raise EDOMNotFound.Create('Element.RemoveAttributeNode');
- end;
- function TDOMElement.GetElementsByTagName(const name: DOMString): TDOMNodeList;
- begin
- Result := FOwnerDocument.GetElementList(Self, '', name, False);
- end;
- function TDOMElement.GetElementsByTagNameNS(const nsURI, aLocalName: DOMString): TDOMNodeList;
- begin
- Result := FOwnerDocument.GetElementList(Self, nsURI, aLocalName, True);
- end;
- function TDOMElement.hasAttribute(const name: DOMString): Boolean;
- begin
- Result := Assigned(FAttributes) and
- Assigned(FAttributes.GetNamedItem(name));
- end;
- function TDOMElement.hasAttributeNS(const nsURI, aLocalName: DOMString): Boolean;
- begin
- Result := Assigned(FAttributes) and
- Assigned(FAttributes.getNamedItemNS(nsURI, aLocalName));
- end;
- function TDOMElement.HasAttributes: Boolean;
- begin
- Result := Assigned(FAttributes) and (FAttributes.Length > 0);
- end;
- // -------------------------------------------------------
- // Text
- // -------------------------------------------------------
- function TDOMText.GetNodeType: Integer;
- begin
- Result := TEXT_NODE;
- end;
- function TDOMText.GetNodeName: DOMString;
- begin
- Result := '#text';
- end;
- procedure TDOMText.SetNodeValue(const aValue: DOMString);
- begin
- inherited SetNodeValue(aValue);
- // TODO: may analyze aValue, but this will slow things down...
- Exclude(FFlags, nfIgnorableWS);
- end;
- function TDOMText.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
- begin
- Result := ACloneOwner.CreateTextNode(FNodeValue);
- end;
- function TDOMText.SplitText(offset: LongWord): TDOMText;
- var
- L: LongWord;
- begin
- Changing;
- L := Length;
- if offset > L then
- raise EDOMIndexSize.Create('Text.SplitText');
- Result := FOwnerDocument.CreateTextNodeBuf(@FNodeValue[offset+1], L-offset, False);
- Result.FFlags := FFlags * [nfIgnorableWS];
- FNodeValue := Copy(FNodeValue, 1, offset);
- if Assigned(FParentNode) then
- FParentNode.InsertBefore(Result, FNextSibling);
- end;
- function TDOMText.IsElementContentWhitespace: Boolean;
- begin
- Result := nfIgnorableWS in FFlags;
- end;
- // -------------------------------------------------------
- // Comment
- // -------------------------------------------------------
- function TDOMComment.GetNodeType: Integer;
- begin
- Result := COMMENT_NODE;
- end;
- function TDOMComment.GetNodeName: DOMString;
- begin
- Result := '#comment';
- end;
- function TDOMComment.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
- begin
- Result := ACloneOwner.CreateComment(FNodeValue);
- end;
- // -------------------------------------------------------
- // CDATASection
- // -------------------------------------------------------
- function TDOMCDATASection.GetNodeType: Integer;
- begin
- Result := CDATA_SECTION_NODE;
- end;
- function TDOMCDATASection.GetNodeName: DOMString;
- begin
- Result := '#cdata-section';
- end;
- function TDOMCDATASection.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
- begin
- Result := ACloneOwner.CreateCDATASection(FNodeValue);
- end;
- // -------------------------------------------------------
- // DocumentType
- // -------------------------------------------------------
- function TDOMDocumentType.GetNodeType: Integer;
- begin
- Result := DOCUMENT_TYPE_NODE;
- end;
- function TDOMDocumentType.GetNodeName: DOMString;
- begin
- Result := FModel.FName;
- end;
- function TDOMDocumentType.GetPublicID: DOMString;
- begin
- Result := FModel.FPublicID;
- end;
- function TDOMDocumentType.GetSystemID: DOMString;
- begin
- Result := FModel.FSystemID;
- end;
- function TDOMDocumentType.GetInternalSubset: DOMString;
- begin
- Result := FModel.FInternalSubset;
- end;
- function ConvertEntity(Entry: PHashItem; arg: Pointer): Boolean;
- var
- this: TDOMDocumentType absolute arg;
- node: TDOMEntity;
- begin
- node := TDOMEntity.Create(this.ownerDocument);
- node.FDecl := TEntityDecl(Entry^.Data);
- node.FBaseURI := node.FDecl.FURI;
- node.SetReadOnly(True);
- this.Entities.SetNamedItem(node);
- Result := True;
- end;
- function ConvertNotation(Entry: PHashItem; arg: Pointer): Boolean;
- var
- this: TDOMDocumentType absolute arg;
- node: TDOMNotation;
- begin
- node := TDOMNotation.Create(this.ownerDocument);
- node.FDecl := TNotationDecl(Entry^.Data);
- node.FBaseURI := node.FDecl.FURI;
- node.SetReadOnly(True);
- this.Notations.SetNamedItem(node);
- Result := True;
- end;
- constructor TDOMDocumentType.Create(aOwner: TDOMDocument; aModel: TDTDModel);
- begin
- inherited Create(aOwner);
- FModel := aModel.Reference;
- FModel.Entities.ForEach(@ConvertEntity, Self);
- FModel.Notations.ForEach(@ConvertNotation, Self);
- SetReadOnly(True);
- end;
- destructor TDOMDocumentType.Destroy;
- begin
- FModel.Release;
- FEntities.Free;
- FNotations.Free;
- inherited Destroy;
- end;
- function TDOMDocumentType.GetEntities: TDOMNamedNodeMap;
- begin
- if FEntities = nil then
- FEntities := TDOMNamedNodeMap.Create(Self);
- Result := FEntities;
- end;
- function TDOMDocumentType.GetNotations: TDOMNamedNodeMap;
- begin
- if FNotations = nil then
- FNotations := TDOMNamedNodeMap.Create(Self);
- Result := FNotations;
- end;
- // -------------------------------------------------------
- // Notation
- // -------------------------------------------------------
- function TDOMNotation.GetNodeType: Integer;
- begin
- Result := NOTATION_NODE;
- end;
- function TDOMNotation.GetNodeName: DOMString;
- begin
- Result := FDecl.FName;
- end;
- function TDOMNotation.GetPublicID: DOMString;
- begin
- Result := FDecl.FPublicID;
- end;
- function TDOMNotation.GetSystemID: DOMString;
- begin
- Result := FDecl.FSystemID;
- end;
- function TDOMNotation.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
- begin
- Result := ACloneOwner.Alloc(TDOMNotation);
- TDOMNotation(Result).Create(ACloneOwner);
- TDOMNotation(Result).FDecl := FDecl;
- // notation cannot have children, ignore Deep
- end;
- // -------------------------------------------------------
- // Entity
- // -------------------------------------------------------
- function TDOMEntity.GetNodeType: Integer;
- begin
- Result := ENTITY_NODE;
- end;
- function TDOMEntity.GetNodeName: DOMString;
- begin
- Result := FDecl.FName;
- end;
- function TDOMEntity.GetPublicID: DOMString;
- begin
- Result := FDecl.FPublicID;
- end;
- function TDOMEntity.GetSystemID: DOMString;
- begin
- Result := FDecl.FSystemID;
- end;
- function TDOMEntity.GetNotationName: DOMString;
- begin
- Result := FDecl.FNotationName;
- end;
- function TDOMEntity.CloneNode(deep: Boolean; aCloneOwner: TDOMDocument): TDOMNode;
- begin
- Result := aCloneOwner.Alloc(TDOMEntity);
- TDOMEntity(Result).Create(aCloneOwner);
- TDOMEntity(Result).FDecl := FDecl;
- if deep then
- CloneChildren(Result, aCloneOwner);
- Result.SetReadOnly(True);
- end;
- // -------------------------------------------------------
- // EntityReference
- // -------------------------------------------------------
- function TDOMEntityReference.GetNodeType: Integer;
- begin
- Result := ENTITY_REFERENCE_NODE;
- end;
- function TDOMEntityReference.GetNodeName: DOMString;
- begin
- Result := FName;
- end;
- function TDOMEntityReference.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
- begin
- Result := ACloneOwner.CreateEntityReference(FName);
- end;
- // -------------------------------------------------------
- // ProcessingInstruction
- // -------------------------------------------------------
- function TDOMProcessingInstruction.CloneNode(deep: Boolean;
- ACloneOwner: TDOMDocument): TDOMNode;
- begin
- Result := ACloneOwner.CreateProcessingInstruction(Target, Data);
- end;
- function TDOMProcessingInstruction.GetNodeType: Integer;
- begin
- Result := PROCESSING_INSTRUCTION_NODE;
- end;
- function TDOMProcessingInstruction.GetNodeName: DOMString;
- begin
- Result := FTarget;
- end;
- function TDOMProcessingInstruction.GetNodeValue: DOMString;
- begin
- Result := FNodeValue;
- end;
- procedure TDOMProcessingInstruction.SetNodeValue(const AValue: DOMString);
- begin
- Changing;
- FNodeValue := AValue;
- end;
- { TNodePool }
- constructor TNodePool.Create(AElementSize: Integer; AElementCount: Integer);
- begin
- FElementSize := AElementSize;
- AddExtent(AElementCount);
- end;
- destructor TNodePool.Destroy;
- var
- ext, next: PExtent;
- ptr, ptr_end: PAnsiChar;
- sz: Integer;
- begin
- ext := FCurrExtent;
- ptr := PAnsiChar(FCurrBlock) + FElementSize;
- sz := FCurrExtentSize;
- while Assigned(ext) do
- begin
- // call destructors for everyone still there
- ptr_end := PAnsiChar(ext) + sizeof(TExtent) + (sz - 1) * FElementSize;
- while ptr <= ptr_end do
- begin
- if TDOMNode(ptr).FPool = Self then
- TObject(ptr).Destroy;
- Inc(ptr, FElementSize);
- end;
- // dispose the extent and pass to the next one
- next := ext^.Next;
- FreeMem(ext);
- ext := next;
- sz := sz div 2;
- ptr := PAnsiChar(ext) + sizeof(TExtent);
- end;
- inherited Destroy;
- end;
- procedure TNodePool.AddExtent(AElemCount: Integer);
- var
- ext: PExtent;
- begin
- Assert((FCurrExtent = nil) or
- (PAnsiChar(FCurrBlock) < PAnsiChar(FCurrExtent) + sizeof(TExtent)));
- Assert(AElemCount > 0);
- GetMem(ext, sizeof(TExtent) + AElemCount * FElementSize);
- ext^.Next := FCurrExtent;
- // point to the beginning of the last block of extent
- FCurrBlock := TDOMNode(PAnsiChar(ext) + sizeof(TExtent) + (AElemCount - 1) * FElementSize);
- FCurrExtent := ext;
- FCurrExtentSize := AElemCount;
- end;
- function TNodePool.AllocNode(AClass: TDOMNodeClass): TDOMNode;
- begin
- if Assigned(FFirstFree) then
- begin
- Result := FFirstFree; // remove from free list
- FFirstFree := TDOMNode(Result.FPool);
- end
- else
- begin
- if PAnsiChar(FCurrBlock) < PAnsiChar(FCurrExtent) + sizeof(TExtent) then
- AddExtent(FCurrExtentSize * 2);
- Result := FCurrBlock;
- Dec(PAnsiChar(FCurrBlock), FElementSize);
- end;
- AClass.InitInstance(Result);
- Result.FPool := Self; // mark as used
- end;
- procedure TNodePool.FreeNode(ANode: TDOMNode);
- begin
- ANode.FPool := FFirstFree;
- FFirstFree := ANode;
- end;
- end.
|