dom.pp 100 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564
  1. {
  2. This file is part of the Free Component Library
  3. Implementation of DOM interfaces
  4. Copyright (c) 1999-2000 by Sebastian Guenther, [email protected]
  5. Modified in 2006 by Sergei Gorelkin, [email protected]
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {
  13. This unit provides classes which implement the interfaces defined in the
  14. DOM (Document Object Model) specification.
  15. The current state is:
  16. DOM Levels 1 and 2 - Completely implemented
  17. DOM Level 3 - Partially implemented
  18. Specification used for this implementation:
  19. "Document Object Model (DOM) Level 2 Specification Version 1.0
  20. W3C Recommendation 11 November, 2000"
  21. http://www.w3.org/TR/2000/REC-DOM-Level-2-Core-20001113
  22. }
  23. unit DOM;
  24. {$ifdef fpc}
  25. {$MODE objfpc}{$H+}
  26. {$endif}
  27. interface
  28. uses
  29. SysUtils, Classes, xmlutils, dtdmodel;
  30. // -------------------------------------------------------
  31. // DOMException
  32. // -------------------------------------------------------
  33. const
  34. // DOM Level 1 exception codes:
  35. INDEX_SIZE_ERR = 1; // index or size is negative, or greater than the allowed value
  36. DOMSTRING_SIZE_ERR = 2; // Specified range of text does not fit into a DOMString
  37. HIERARCHY_REQUEST_ERR = 3; // node is inserted somewhere it does not belong
  38. WRONG_DOCUMENT_ERR = 4; // node is used in a different document than the one that created it (that does not support it)
  39. INVALID_CHARACTER_ERR = 5; // invalid or illegal character is specified, such as in a name
  40. NO_DATA_ALLOWED_ERR = 6; // data is specified for a node which does not support data
  41. NO_MODIFICATION_ALLOWED_ERR = 7; // an attempt is made to modify an object where modifications are not allowed
  42. NOT_FOUND_ERR = 8; // an attempt is made to reference a node in a context where it does not exist
  43. NOT_SUPPORTED_ERR = 9; // implementation does not support the type of object requested
  44. INUSE_ATTRIBUTE_ERR = 10; // an attempt is made to add an attribute that is already in use elsewhere
  45. // DOM Level 2 exception codes:
  46. INVALID_STATE_ERR = 11; // an attempt is made to use an object that is not, or is no longer, usable
  47. SYNTAX_ERR = 12; // invalid or illegal string specified
  48. INVALID_MODIFICATION_ERR = 13; // an attempt is made to modify the type of the underlying object
  49. NAMESPACE_ERR = 14; // an attempt is made to create or change an object in a way which is incorrect with regard to namespaces
  50. INVALID_ACCESS_ERR = 15; // parameter or operation is not supported by the underlying object
  51. // -------------------------------------------------------
  52. // Node
  53. // -------------------------------------------------------
  54. const
  55. ELEMENT_NODE = 1;
  56. ATTRIBUTE_NODE = 2;
  57. TEXT_NODE = 3;
  58. CDATA_SECTION_NODE = 4;
  59. ENTITY_REFERENCE_NODE = 5;
  60. ENTITY_NODE = 6;
  61. PROCESSING_INSTRUCTION_NODE = 7;
  62. COMMENT_NODE = 8;
  63. DOCUMENT_NODE = 9;
  64. DOCUMENT_TYPE_NODE = 10;
  65. DOCUMENT_FRAGMENT_NODE = 11;
  66. NOTATION_NODE = 12;
  67. type
  68. TDOMDocument = class;
  69. TDOMNodeList = class;
  70. TDOMNamedNodeMap = class;
  71. TDOMAttr = class;
  72. TDOMElement = class;
  73. TDOMText = class;
  74. TDOMComment = class;
  75. TDOMCDATASection = class;
  76. TDOMDocumentType = class;
  77. TDOMEntityReference = class;
  78. TDOMProcessingInstruction = class;
  79. TNodePool = class;
  80. PNodePoolArray = ^TNodePoolArray;
  81. TNodePoolArray = array[0..MaxInt div sizeof(Pointer)-1] of TNodePool;
  82. {$ifndef fpc}
  83. TFPList = TList;
  84. {$endif}
  85. // -------------------------------------------------------
  86. // DOMString
  87. // -------------------------------------------------------
  88. TSetOfChar = xmlutils.TSetOfChar; { to be removed: not used in DOM unit }
  89. DOMString = XMLString;
  90. DOMPChar = PXMLChar;
  91. PDOMString = ^DOMString;
  92. EDOMError = class(Exception)
  93. public
  94. Code: Integer;
  95. constructor Create(ACode: Integer; const ASituation: String);
  96. end;
  97. EDOMIndexSize = class(EDOMError)
  98. public
  99. constructor Create(const ASituation: String);
  100. end;
  101. EDOMHierarchyRequest = class(EDOMError)
  102. public
  103. constructor Create(const ASituation: String);
  104. end;
  105. EDOMWrongDocument = class(EDOMError)
  106. public
  107. constructor Create(const ASituation: String);
  108. end;
  109. EDOMNotFound = class(EDOMError)
  110. public
  111. constructor Create(const ASituation: String);
  112. end;
  113. EDOMNotSupported = class(EDOMError)
  114. public
  115. constructor Create(const ASituation: String);
  116. end;
  117. EDOMInUseAttribute = class(EDOMError)
  118. public
  119. constructor Create(const ASituation: String);
  120. end;
  121. EDOMInvalidState = class(EDOMError)
  122. public
  123. constructor Create(const ASituation: String);
  124. end;
  125. EDOMSyntax = class(EDOMError)
  126. public
  127. constructor Create(const ASituation: String);
  128. end;
  129. EDOMInvalidModification = class(EDOMError)
  130. public
  131. constructor Create(const ASituation: String);
  132. end;
  133. EDOMNamespace = class(EDOMError)
  134. public
  135. constructor Create(const ASituation: String);
  136. end;
  137. EDOMInvalidAccess = class(EDOMError)
  138. public
  139. constructor Create(const ASituation: String);
  140. end;
  141. { NodeType, NodeName and NodeValue had been moved from fields to functions.
  142. This lowers memory usage and also obsoletes most constructors,
  143. at a slight performance penalty. However, NodeName and NodeValue are
  144. accessible via fields using specialized properties of descendant classes,
  145. e.g. TDOMElement.TagName, TDOMCharacterData.Data etc.}
  146. TNodeFlagEnum = (
  147. nfReadonly,
  148. nfRecycled,
  149. nfLevel2,
  150. nfIgnorableWS,
  151. nfSpecified,
  152. nfDestroying,
  153. nfFirstChild
  154. );
  155. TNodeFlags = set of TNodeFlagEnum;
  156. TDOMNode = class
  157. protected
  158. FPool: TObject;
  159. FFlags: TNodeFlags;
  160. FParentNode: TDOMNode;
  161. FPreviousSibling, FNextSibling: TDOMNode;
  162. FOwnerDocument: TDOMDocument;
  163. function GetNodeName: DOMString; virtual; abstract;
  164. function GetNodeValue: DOMString; virtual;
  165. function GetParentNode: TDOMNode; virtual;
  166. procedure SetNodeValue(const AValue: DOMString); virtual;
  167. function GetFirstChild: TDOMNode; virtual;
  168. function GetLastChild: TDOMNode; virtual;
  169. function GetPreviousSibling: TDOMNode; virtual;
  170. function GetAttributes: TDOMNamedNodeMap; virtual;
  171. function GetRevision: Integer;
  172. function GetNodeType: Integer; virtual; abstract;
  173. function GetTextContent: DOMString; virtual;
  174. procedure SetTextContent(const AValue: DOMString); virtual;
  175. function GetLocalName: DOMString; virtual;
  176. function GetNamespaceURI: DOMString; virtual;
  177. function GetPrefix: DOMString; virtual;
  178. procedure SetPrefix(const Value: DOMString); virtual;
  179. function GetOwnerDocument: TDOMDocument; virtual;
  180. function GetBaseURI: DOMString;
  181. procedure SetReadOnly(Value: Boolean);
  182. procedure Changing;
  183. public
  184. constructor Create(AOwner: TDOMDocument);
  185. destructor Destroy; override;
  186. procedure FreeInstance; override;
  187. function GetChildNodes: TDOMNodeList;
  188. property NodeName: DOMString read GetNodeName;
  189. property NodeValue: DOMString read GetNodeValue write SetNodeValue;
  190. property NodeType: Integer read GetNodeType;
  191. property ParentNode: TDOMNode read GetParentNode;
  192. property FirstChild: TDOMNode read GetFirstChild;
  193. property LastChild: TDOMNode read GetLastChild;
  194. property ChildNodes: TDOMNodeList read GetChildNodes;
  195. property PreviousSibling: TDOMNode read GetPreviousSibling;
  196. property NextSibling: TDOMNode read FNextSibling;
  197. property Attributes: TDOMNamedNodeMap read GetAttributes;
  198. property OwnerDocument: TDOMDocument read GetOwnerDocument;
  199. function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; virtual;
  200. function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; virtual;
  201. function DetachChild(OldChild: TDOMNode): TDOMNode; virtual;
  202. function RemoveChild(OldChild: TDOMNode): TDOMNode;
  203. function AppendChild(NewChild: TDOMNode): TDOMNode;
  204. function HasChildNodes: Boolean; virtual;
  205. function CloneNode(deep: Boolean): TDOMNode; overload; virtual;
  206. // DOM level 2
  207. function IsSupported(const Feature, Version: DOMString): Boolean;
  208. function HasAttributes: Boolean; virtual;
  209. procedure Normalize; virtual;
  210. property NamespaceURI: DOMString read GetNamespaceURI;
  211. property LocalName: DOMString read GetLocalName;
  212. property Prefix: DOMString read GetPrefix write SetPrefix;
  213. // DOM level 3
  214. property TextContent: DOMString read GetTextContent write SetTextContent;
  215. function LookupPrefix(const nsURI: DOMString): DOMString;
  216. function LookupNamespaceURI(const APrefix: DOMString): DOMString;
  217. function IsDefaultNamespace(const nsURI: DOMString): Boolean;
  218. property baseURI: DOMString read GetBaseURI;
  219. // Extensions to DOM interface:
  220. function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; virtual;
  221. function FindNode(const ANodeName: DOMString): TDOMNode; virtual;
  222. function CompareName(const name: DOMString): Integer; virtual;
  223. property Flags: TNodeFlags read FFlags;
  224. end;
  225. TDOMNodeClass = class of TDOMNode;
  226. { The following class is an implementation specific extension, it is just an
  227. extended implementation of TDOMNode, the generic DOM::Node interface
  228. implementation. (Its main purpose is to save memory in a big node tree) }
  229. TDOMNode_WithChildren = class(TDOMNode)
  230. protected
  231. FFirstChild: TDOMNode;
  232. FChildNodes: TDOMNodeList;
  233. function GetFirstChild: TDOMNode; override;
  234. function GetLastChild: TDOMNode; override;
  235. procedure CloneChildren(ACopy: TDOMNode; ACloneOwner: TDOMDocument);
  236. procedure FreeChildren;
  237. function GetTextContent: DOMString; override;
  238. procedure SetTextContent(const AValue: DOMString); override;
  239. public
  240. destructor Destroy; override;
  241. function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; override;
  242. function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; override;
  243. function DetachChild(OldChild: TDOMNode): TDOMNode; override;
  244. function HasChildNodes: Boolean; override;
  245. function FindNode(const ANodeName: DOMString): TDOMNode; override;
  246. procedure InternalAppend(NewChild: TDOMNode);
  247. end;
  248. { A common ancestor for Document and Entity nodes. }
  249. TDOMNode_TopLevel = class(TDOMNode_WithChildren)
  250. protected
  251. FInputEncoding: DOMString;
  252. FXMLEncoding: DOMString;
  253. FURI: DOMString;
  254. FXMLVersion: TXMLVersion;
  255. function GetXMLVersion: DOMString;
  256. public
  257. property InputEncoding: DOMString read FInputEncoding;
  258. property XMLEncoding: DOMString read FXMLEncoding;
  259. end;
  260. // -------------------------------------------------------
  261. // NodeList
  262. // -------------------------------------------------------
  263. TFilterResult = (frFalse, frNorecurseFalse, frTrue, frNorecurseTrue);
  264. TDOMNodeList = class(TObject)
  265. protected
  266. FNode: TDOMNode;
  267. FRevision: Integer;
  268. FList: TFPList;
  269. function GetCount: LongWord;
  270. function GetItem(index: LongWord): TDOMNode;
  271. function NodeFilter(aNode: TDOMNode): TFilterResult; virtual;
  272. // now deprecated in favor of NodeFilter
  273. procedure BuildList; virtual;
  274. public
  275. constructor Create(ANode: TDOMNode);
  276. destructor Destroy; override;
  277. property Item[index: LongWord]: TDOMNode read GetItem; default;
  278. property Count: LongWord read GetCount;
  279. property Length: LongWord read GetCount;
  280. end;
  281. { an extension to DOM interface, used to build recursive lists of elements }
  282. TDOMElementList = class(TDOMNodeList)
  283. protected
  284. filter: DOMString;
  285. FNSIndexFilter: Integer;
  286. localNameFilter: DOMString;
  287. FMatchNS: Boolean;
  288. FMatchAnyNS: Boolean;
  289. UseFilter: Boolean;
  290. function NodeFilter(aNode: TDOMNode): TFilterResult; override;
  291. public
  292. constructor Create(ANode: TDOMNode; const AFilter: DOMString); overload;
  293. constructor Create(ANode: TDOMNode; const nsURI, localName: DOMString); overload;
  294. end;
  295. // -------------------------------------------------------
  296. // NamedNodeMap
  297. // -------------------------------------------------------
  298. TDOMNamedNodeMap = class(TObject)
  299. protected
  300. FOwner: TDOMNode;
  301. FList: TFPList;
  302. function GetItem(index: LongWord): TDOMNode;
  303. function GetLength: LongWord;
  304. function Find(const name: DOMString; out Index: LongWord): Boolean;
  305. function Delete(index: LongWord): TDOMNode; virtual;
  306. function InternalRemove(const name: DOMString): TDOMNode;
  307. function ValidateInsert(arg: TDOMNode): Integer; virtual;
  308. public
  309. constructor Create(AOwner: TDOMNode);
  310. destructor Destroy; override;
  311. function GetNamedItem(const name: DOMString): TDOMNode;
  312. function SetNamedItem(arg: TDOMNode): TDOMNode; virtual;
  313. function RemoveNamedItem(const name: DOMString): TDOMNode;
  314. // Introduced in DOM Level 2:
  315. function getNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode; virtual;
  316. function setNamedItemNS(arg: TDOMNode): TDOMNode; virtual;
  317. function removeNamedItemNS(const namespaceURI,localName: DOMString): TDOMNode; virtual;
  318. property Item[index: LongWord]: TDOMNode read GetItem; default;
  319. property Length: LongWord read GetLength;
  320. end;
  321. // -------------------------------------------------------
  322. // CharacterData
  323. // -------------------------------------------------------
  324. TDOMCharacterData = class(TDOMNode)
  325. private
  326. FNodeValue: DOMString;
  327. protected
  328. function GetLength: LongWord;
  329. function GetNodeValue: DOMString; override;
  330. procedure SetNodeValue(const AValue: DOMString); override;
  331. public
  332. property Data: DOMString read FNodeValue write SetNodeValue;
  333. property Length: LongWord read GetLength;
  334. function SubstringData(offset, count: LongWord): DOMString;
  335. procedure AppendData(const arg: DOMString);
  336. procedure InsertData(offset: LongWord; const arg: DOMString);
  337. procedure DeleteData(offset, count: LongWord);
  338. procedure ReplaceData(offset, count: LongWord; const arg: DOMString);
  339. end;
  340. // -------------------------------------------------------
  341. // DOMImplementation
  342. // -------------------------------------------------------
  343. TDOMImplementation = class
  344. public
  345. function HasFeature(const feature, version: DOMString): Boolean;
  346. // Introduced in DOM Level 2:
  347. function CreateDocumentType(const QualifiedName, PublicID,
  348. SystemID: DOMString): TDOMDocumentType;
  349. function CreateDocument(const NamespaceURI, QualifiedName: DOMString;
  350. doctype: TDOMDocumentType): TDOMDocument;
  351. end;
  352. // -------------------------------------------------------
  353. // DocumentFragment
  354. // -------------------------------------------------------
  355. TDOMDocumentFragment = class(TDOMNode_WithChildren)
  356. protected
  357. function GetNodeType: Integer; override;
  358. function GetNodeName: DOMString; override;
  359. public
  360. function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
  361. end;
  362. // -------------------------------------------------------
  363. // Document
  364. // -------------------------------------------------------
  365. // TODO: to be replaced by more suitable container
  366. TNamespaces = array of DOMString;
  367. TDOMDocument = class(TDOMNode_TopLevel)
  368. protected
  369. FIDList: THashTable;
  370. FRevision: Integer;
  371. FImplementation: TDOMImplementation;
  372. FNamespaces: TNamespaces;
  373. FNames: THashTable;
  374. FEmptyNode: TDOMElement;
  375. FNodeLists: THashTable;
  376. FMaxPoolSize: Integer;
  377. FPools: PNodePoolArray;
  378. FXmlStandalone: Boolean;
  379. function GetDocumentElement: TDOMElement;
  380. function GetDocType: TDOMDocumentType;
  381. function GetNodeType: Integer; override;
  382. function GetNodeName: DOMString; override;
  383. function GetTextContent: DOMString; override;
  384. function GetOwnerDocument: TDOMDocument; override;
  385. procedure SetTextContent(const value: DOMString); override;
  386. procedure RemoveID(Elem: TDOMElement);
  387. function GetChildNodeList(aNode: TDOMNode): TDOMNodeList;
  388. function GetElementList(aNode: TDOMNode; const nsURI, aLocalName: DOMString; UseNS: Boolean): TDOMNodeList;
  389. procedure NodeListDestroyed(aList: TDOMNodeList);
  390. function Alloc(AClass: TDOMNodeClass): TDOMNode;
  391. procedure SetXMLVersion(const aValue: DOMString); virtual;
  392. procedure SetXMLStandalone(aValue: Boolean); virtual;
  393. public
  394. function IndexOfNS(const nsURI: DOMString; AddIfAbsent: Boolean = False): Integer;
  395. function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; override;
  396. function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; override;
  397. property DocType: TDOMDocumentType read GetDocType;
  398. property Impl: TDOMImplementation read FImplementation;
  399. property DocumentElement: TDOMElement read GetDocumentElement;
  400. function CreateElement(const tagName: DOMString): TDOMElement; virtual;
  401. function CreateElementBuf(Buf: DOMPChar; Length: Integer): TDOMElement;
  402. function CreateDocumentFragment: TDOMDocumentFragment;
  403. function CreateTextNode(const data: DOMString): TDOMText;
  404. function CreateTextNodeBuf(Buf: DOMPChar; Length: Integer; IgnWS: Boolean): TDOMText;
  405. function CreateComment(const data: DOMString): TDOMComment;
  406. function CreateCommentBuf(Buf: DOMPChar; Length: Integer): TDOMComment;
  407. function CreateCDATASection(const data: DOMString): TDOMCDATASection;
  408. virtual;
  409. function CreateProcessingInstruction(const target, data: DOMString):
  410. TDOMProcessingInstruction; virtual;
  411. function CreateAttribute(const name: DOMString): TDOMAttr;
  412. function CreateAttributeBuf(Buf: DOMPChar; Length: Integer): TDOMAttr;
  413. function CreateEntityReference(const name: DOMString): TDOMEntityReference;
  414. virtual;
  415. function GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
  416. // DOM level 2 methods
  417. function ImportNode(ImportedNode: TDOMNode; Deep: Boolean): TDOMNode;
  418. function CreateElementNS(const nsURI, QualifiedName: DOMString): TDOMElement;
  419. function CreateAttributeNS(const nsURI, QualifiedName: DOMString): TDOMAttr;
  420. function GetElementsByTagNameNS(const nsURI, alocalName: DOMString): TDOMNodeList;
  421. function GetElementById(const ElementID: DOMString): TDOMElement;
  422. // DOM level 3:
  423. property documentURI: DOMString read FURI write FURI;
  424. property XMLVersion: DOMString read GetXMLVersion write SetXMLVersion;
  425. property XMLStandalone: Boolean read FXmlStandalone write SetXmlStandalone;
  426. // Extensions to DOM interface:
  427. constructor Create; virtual;
  428. destructor Destroy; override;
  429. function CloneNode(deep: Boolean): TDOMNode; overload; override;
  430. property Names: THashTable read FNames;
  431. property IDs: THashTable read FIDList write FIDList;
  432. end;
  433. TXMLDocument = class(TDOMDocument)
  434. protected
  435. procedure SetXMLVersion(const aValue: DOMString); override;
  436. procedure SetXMLStandalone(aValue: Boolean); override;
  437. public
  438. // These fields are extensions to the DOM interface:
  439. StylesheetType, StylesheetHRef: DOMString;
  440. constructor Create; override;
  441. function CreateCDATASection(const data: DOMString): TDOMCDATASection; override;
  442. function CreateProcessingInstruction(const target, data: DOMString):
  443. TDOMProcessingInstruction; override;
  444. function CreateEntityReference(const name: DOMString): TDOMEntityReference; override;
  445. end;
  446. // This limits number of namespaces per document to 65535,
  447. // and prefix length to 65535, too.
  448. // I believe that higher values may only be found in deliberately malformed documents.
  449. TNamespaceInfo = packed record
  450. NSIndex: Word;
  451. PrefixLen: Word;
  452. QName: PHashItem;
  453. end;
  454. // -------------------------------------------------------
  455. // Attr
  456. // -------------------------------------------------------
  457. TAttrDataType = xmlutils.TAttrDataType;
  458. TDOMNode_NS = class(TDOMNode_WithChildren)
  459. protected
  460. FNSI: TNamespaceInfo;
  461. function GetNodeName: DOMString; override;
  462. function GetLocalName: DOMString; override;
  463. function GetNamespaceURI: DOMString; override;
  464. function GetPrefix: DOMString; override;
  465. procedure SetPrefix(const Value: DOMString); override;
  466. public
  467. { Used by parser }
  468. procedure SetNSI(const nsUri: DOMString; ColonPos: Integer);
  469. function CompareName(const AName: DOMString): Integer; override;
  470. property NSI: TNamespaceInfo read FNSI;
  471. end;
  472. TDOMAttr = class(TDOMNode_NS)
  473. protected
  474. FDataType: TAttrDataType;
  475. function GetNodeValue: DOMString; override;
  476. function GetNodeType: Integer; override;
  477. function GetParentNode: TDOMNode; override;
  478. function GetSpecified: Boolean;
  479. function GetIsID: Boolean;
  480. function GetOwnerElement: TDOMElement;
  481. procedure SetNodeValue(const AValue: DOMString); override;
  482. public
  483. destructor Destroy; override;
  484. function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
  485. property Name: DOMString read GetNodeName;
  486. property Specified: Boolean read GetSpecified;
  487. property Value: DOMString read GetNodeValue write SetNodeValue;
  488. property OwnerElement: TDOMElement read GetOwnerElement;
  489. property IsID: Boolean read GetIsID;
  490. // extensions
  491. // TODO: this is to be replaced with DOM 3 TypeInfo
  492. property DataType: TAttrDataType read FDataType write FDataType;
  493. end;
  494. // -------------------------------------------------------
  495. // Element
  496. // -------------------------------------------------------
  497. TDOMElement = class(TDOMNode_NS)
  498. protected
  499. FAttributes: TDOMNamedNodeMap;
  500. function GetNodeType: Integer; override;
  501. function GetAttributes: TDOMNamedNodeMap; override;
  502. procedure AttachDefaultAttrs;
  503. function InternalLookupPrefix(const nsURI: DOMString; Original: TDOMElement): DOMString;
  504. procedure RestoreDefaultAttr(AttrDef: TAttributeDef);
  505. public
  506. destructor Destroy; override;
  507. function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
  508. procedure Normalize; override;
  509. property TagName: DOMString read GetNodeName;
  510. function GetAttribute(const name: DOMString): DOMString;
  511. procedure SetAttribute(const name, value: DOMString);
  512. procedure RemoveAttribute(const name: DOMString);
  513. function GetAttributeNode(const name: DOMString): TDOMAttr;
  514. function SetAttributeNode(NewAttr: TDOMAttr): TDOMAttr;
  515. function RemoveAttributeNode(OldAttr: TDOMAttr): TDOMAttr;
  516. function GetElementsByTagName(const name: DOMString): TDOMNodeList;
  517. // Introduced in DOM Level 2:
  518. function GetAttributeNS(const nsURI, aLocalName: DOMString): DOMString;
  519. procedure SetAttributeNS(const nsURI, qualifiedName, value: DOMString);
  520. procedure RemoveAttributeNS(const nsURI, aLocalName: DOMString);
  521. function GetAttributeNodeNS(const nsURI, aLocalName: DOMString): TDOMAttr;
  522. function SetAttributeNodeNS(newAttr: TDOMAttr): TDOMAttr;
  523. function GetElementsByTagNameNS(const nsURI, aLocalName: DOMString): TDOMNodeList;
  524. function hasAttribute(const name: DOMString): Boolean;
  525. function hasAttributeNS(const nsURI, aLocalName: DOMString): Boolean;
  526. function HasAttributes: Boolean; override;
  527. // extension
  528. property AttribStrings[const Name: DOMString]: DOMString
  529. read GetAttribute write SetAttribute; default;
  530. end;
  531. // -------------------------------------------------------
  532. // Text
  533. // -------------------------------------------------------
  534. TDOMText = class(TDOMCharacterData)
  535. protected
  536. function GetNodeType: Integer; override;
  537. function GetNodeName: DOMString; override;
  538. procedure SetNodeValue(const aValue: DOMString); override;
  539. public
  540. function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
  541. function SplitText(offset: LongWord): TDOMText;
  542. function IsElementContentWhitespace: Boolean;
  543. end;
  544. // -------------------------------------------------------
  545. // Comment
  546. // -------------------------------------------------------
  547. TDOMComment = class(TDOMCharacterData)
  548. protected
  549. function GetNodeType: Integer; override;
  550. function GetNodeName: DOMString; override;
  551. public
  552. function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
  553. end;
  554. // -------------------------------------------------------
  555. // CDATASection
  556. // -------------------------------------------------------
  557. TDOMCDATASection = class(TDOMText)
  558. protected
  559. function GetNodeType: Integer; override;
  560. function GetNodeName: DOMString; override;
  561. public
  562. function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
  563. end;
  564. // -------------------------------------------------------
  565. // DocumentType
  566. // -------------------------------------------------------
  567. TDOMDocumentType = class(TDOMNode)
  568. protected
  569. FModel: TDTDModel;
  570. FEntities, FNotations: TDOMNamedNodeMap;
  571. function GetEntities: TDOMNamedNodeMap;
  572. function GetNotations: TDOMNamedNodeMap;
  573. function GetNodeType: Integer; override;
  574. function GetNodeName: DOMString; override;
  575. function GetPublicID: DOMString;
  576. function GetSystemID: DOMString;
  577. function GetInternalSubset: DOMString;
  578. public
  579. constructor Create(aOwner: TDOMDocument; aModel: TDTDModel);
  580. destructor Destroy; override;
  581. property Name: DOMString read GetNodeName;
  582. property Entities: TDOMNamedNodeMap read GetEntities;
  583. property Notations: TDOMNamedNodeMap read GetNotations;
  584. // Introduced in DOM Level 2:
  585. property PublicID: DOMString read GetPublicID;
  586. property SystemID: DOMString read GetSystemID;
  587. property InternalSubset: DOMString read GetInternalSubset;
  588. end;
  589. // -------------------------------------------------------
  590. // Notation
  591. // -------------------------------------------------------
  592. TDOMNotation = class(TDOMNode)
  593. protected
  594. FDecl: TNotationDecl;
  595. FBaseURI: DOMString;
  596. function GetNodeType: Integer; override;
  597. function GetNodeName: DOMString; override;
  598. function GetPublicID: DOMString;
  599. function GetSystemID: DOMString;
  600. public
  601. function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
  602. property PublicID: DOMString read GetPublicID;
  603. property SystemID: DOMString read GetSystemID;
  604. end;
  605. // -------------------------------------------------------
  606. // Entity
  607. // -------------------------------------------------------
  608. TDOMEntity = class(TDOMNode_TopLevel)
  609. protected
  610. FDecl: TEntityDecl;
  611. FBaseURI: DOMString;
  612. function GetNodeType: Integer; override;
  613. function GetNodeName: DOMString; override;
  614. function GetPublicID: DOMString;
  615. function GetSystemID: DOMString;
  616. function GetNotationName: DOMString;
  617. public
  618. function CloneNode(deep: Boolean; aCloneOwner: TDOMDocument): TDOMNode; override;
  619. property PublicID: DOMString read GetPublicID;
  620. property SystemID: DOMString read GetSystemID;
  621. property NotationName: DOMString read GetNotationName;
  622. property XMLVersion: DOMString read GetXMLVersion;
  623. end;
  624. // -------------------------------------------------------
  625. // EntityReference
  626. // -------------------------------------------------------
  627. TDOMEntityReference = class(TDOMNode_WithChildren)
  628. protected
  629. FName: DOMString;
  630. function GetNodeType: Integer; override;
  631. function GetNodeName: DOMString; override;
  632. public
  633. function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
  634. end;
  635. // -------------------------------------------------------
  636. // ProcessingInstruction
  637. // -------------------------------------------------------
  638. TDOMProcessingInstruction = class(TDOMNode)
  639. private
  640. FTarget: DOMString;
  641. FNodeValue: DOMString;
  642. protected
  643. function GetNodeType: Integer; override;
  644. function GetNodeName: DOMString; override;
  645. function GetNodeValue: DOMString; override;
  646. procedure SetNodeValue(const AValue: DOMString); override;
  647. public
  648. function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
  649. property Target: DOMString read FTarget;
  650. property Data: DOMString read FNodeValue write SetNodeValue;
  651. end;
  652. // TNodePool - custom memory management for TDOMNode's
  653. // One pool manages objects of the same InstanceSize (may be of various classes)
  654. PExtent = ^TExtent;
  655. TExtent = record
  656. Next: PExtent;
  657. // following: array of TDOMNode instances
  658. end;
  659. TNodePool = class(TObject)
  660. private
  661. FCurrExtent: PExtent;
  662. FCurrExtentSize: Integer;
  663. FElementSize: Integer;
  664. FCurrBlock: TDOMNode;
  665. FFirstFree: TDOMNode;
  666. procedure AddExtent(AElemCount: Integer);
  667. public
  668. constructor Create(AElementSize: Integer; AElementCount: Integer = 32);
  669. destructor Destroy; override;
  670. function AllocNode(AClass: TDOMNodeClass): TDOMNode;
  671. procedure FreeNode(ANode: TDOMNode);
  672. end;
  673. // temporary until things are settled
  674. function LoadElement(doc: TDOMDocument; src: PNodeData; attrCount: Integer): TDOMElement;
  675. // =======================================================
  676. // =======================================================
  677. implementation
  678. uses
  679. UriParser;
  680. { a namespace-enabled NamedNodeMap }
  681. type
  682. TAttributeMap = class(TDOMNamedNodeMap)
  683. private
  684. function FindNS(nsIndex: Integer; const aLocalName: DOMString;
  685. out Index: LongWord): Boolean;
  686. function InternalRemoveNS(const nsURI, aLocalName: DOMString): TDOMNode;
  687. procedure RestoreDefault(aName: PHashItem);
  688. protected
  689. function Delete(index: LongWord): TDOMNode; override;
  690. function ValidateInsert(arg: TDOMNode): Integer; override;
  691. public
  692. function setNamedItem(arg: TDOMNode): TDOMNode; override;
  693. function getNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode; override;
  694. function setNamedItemNS(arg: TDOMNode): TDOMNode; override;
  695. function removeNamedItemNS(const namespaceURI,localName: DOMString): TDOMNode; override;
  696. end;
  697. // -------------------------------------------------------
  698. // DOM Exception
  699. // -------------------------------------------------------
  700. constructor EDOMError.Create(ACode: Integer; const ASituation: String);
  701. begin
  702. Code := ACode;
  703. inherited Create(Self.ClassName + ' in ' + ASituation);
  704. end;
  705. constructor EDOMIndexSize.Create(const ASituation: String); // 1
  706. begin
  707. inherited Create(INDEX_SIZE_ERR, ASituation);
  708. end;
  709. constructor EDOMHierarchyRequest.Create(const ASituation: String); // 3
  710. begin
  711. inherited Create(HIERARCHY_REQUEST_ERR, ASituation);
  712. end;
  713. constructor EDOMWrongDocument.Create(const ASituation: String); // 4
  714. begin
  715. inherited Create(WRONG_DOCUMENT_ERR, ASituation);
  716. end;
  717. constructor EDOMNotFound.Create(const ASituation: String); // 8
  718. begin
  719. inherited Create(NOT_FOUND_ERR, ASituation);
  720. end;
  721. constructor EDOMNotSupported.Create(const ASituation: String); // 9
  722. begin
  723. inherited Create(NOT_SUPPORTED_ERR, ASituation);
  724. end;
  725. constructor EDOMInUseAttribute.Create(const ASituation: String); // 10
  726. begin
  727. inherited Create(INUSE_ATTRIBUTE_ERR, ASituation);
  728. end;
  729. constructor EDOMInvalidState.Create(const ASituation: String); // 11
  730. begin
  731. inherited Create(INVALID_STATE_ERR, ASituation);
  732. end;
  733. constructor EDOMSyntax.Create(const ASituation: String); // 12
  734. begin
  735. inherited Create(SYNTAX_ERR, ASituation);
  736. end;
  737. constructor EDOMInvalidModification.Create(const ASituation: String); // 13
  738. begin
  739. inherited Create(INVALID_MODIFICATION_ERR, ASituation);
  740. end;
  741. constructor EDOMNamespace.Create(const ASituation: String); // 14
  742. begin
  743. inherited Create(NAMESPACE_ERR, ASituation);
  744. end;
  745. constructor EDOMInvalidAccess.Create(const ASituation: String); // 15
  746. begin
  747. inherited Create(INVALID_ACCESS_ERR, ASituation);
  748. end;
  749. // -------------------------------------------------------
  750. // Node
  751. // -------------------------------------------------------
  752. constructor TDOMNode.Create(AOwner: TDOMDocument);
  753. begin
  754. FOwnerDocument := AOwner;
  755. inherited Create;
  756. end;
  757. destructor TDOMNode.Destroy;
  758. begin
  759. if Assigned(FParentNode) then
  760. FParentNode.DetachChild(Self);
  761. inherited Destroy;
  762. end;
  763. procedure TDOMNode.FreeInstance;
  764. begin
  765. if Assigned(FPool) then
  766. begin
  767. CleanupInstance;
  768. TNodePool(FPool).FreeNode(Self);
  769. end
  770. else
  771. inherited FreeInstance;
  772. end;
  773. function TDOMNode.GetNodeValue: DOMString;
  774. begin
  775. Result := '';
  776. end;
  777. function TDOMNode.GetParentNode: TDOMNode;
  778. begin
  779. Result := FParentNode;
  780. end;
  781. procedure TDOMNode.SetNodeValue(const AValue: DOMString);
  782. begin
  783. // do nothing
  784. end;
  785. function TDOMNode.GetChildNodes: TDOMNodeList;
  786. begin
  787. Result := FOwnerDocument.GetChildNodeList(Self);
  788. end;
  789. function TDOMNode.GetFirstChild: TDOMNode;
  790. begin
  791. Result := nil;
  792. end;
  793. function TDOMNode.GetLastChild: TDOMNode;
  794. begin
  795. Result := nil;
  796. end;
  797. function TDOMNode.GetPreviousSibling: TDOMNode;
  798. begin
  799. if nfFirstChild in FFlags then
  800. Result := nil
  801. else
  802. Result := FPreviousSibling;
  803. end;
  804. function TDOMNode.GetAttributes: TDOMNamedNodeMap;
  805. begin
  806. Result := nil;
  807. end;
  808. function TDOMNode.InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode;
  809. begin
  810. Changing; // merely to comply with core3/nodeinsertbefore14
  811. raise EDOMHierarchyRequest.Create('Node.InsertBefore');
  812. Result:=nil;
  813. end;
  814. function TDOMNode.ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode;
  815. begin
  816. Changing; // merely to comply with core3/nodereplacechild21
  817. raise EDOMHierarchyRequest.Create('Node.ReplaceChild');
  818. Result:=nil;
  819. end;
  820. function TDOMNode.DetachChild(OldChild: TDOMNode): TDOMNode;
  821. begin
  822. // OldChild isn't in our child list
  823. raise EDOMNotFound.Create('Node.RemoveChild');
  824. Result:=nil;
  825. end;
  826. function TDOMNode.RemoveChild(OldChild: TDOMNode): TDOMNode;
  827. begin
  828. Result := DetachChild(OldChild);
  829. end;
  830. function TDOMNode.AppendChild(NewChild: TDOMNode): TDOMNode;
  831. begin
  832. Result := InsertBefore(NewChild, nil);
  833. end;
  834. function TDOMNode.HasChildNodes: Boolean;
  835. begin
  836. Result := False;
  837. end;
  838. function TDOMNode.CloneNode(deep: Boolean): TDOMNode;
  839. begin
  840. Result := CloneNode(deep, FOwnerDocument);
  841. end;
  842. function TDOMNode.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
  843. begin
  844. // !! CreateFmt() does not set Code property !!
  845. raise EDOMNotSupported.Create(Format('Cloning/importing of %s is not supported', [ClassName]));
  846. Result:=nil;
  847. end;
  848. function TDOMNode.FindNode(const ANodeName: DOMString): TDOMNode;
  849. begin
  850. // FIX: we have no children, hence cannot find anything
  851. Result := nil;
  852. end;
  853. function TDOMNode.GetRevision: Integer;
  854. begin
  855. Result := FOwnerDocument.FRevision;
  856. end;
  857. function TDOMNode.IsSupported(const Feature, Version: DOMString): Boolean;
  858. begin
  859. Result := FOwnerDocument.Impl.HasFeature(Feature, Version);
  860. end;
  861. function TDOMNode.HasAttributes: Boolean;
  862. begin
  863. Result := False;
  864. end;
  865. procedure TDOMNode.Normalize;
  866. var
  867. Child, tmp: TDOMNode;
  868. Txt: TDOMText;
  869. begin
  870. Child := FirstChild;
  871. Txt := nil;
  872. while Assigned(Child) do
  873. begin
  874. if Child.NodeType = TEXT_NODE then
  875. begin
  876. tmp := Child.NextSibling;
  877. if TDOMText(Child).Data <> '' then
  878. begin
  879. if Assigned(Txt) then
  880. begin
  881. Txt.AppendData(TDOMText(Child).Data);
  882. // TODO: maybe should be smarter
  883. Exclude(Txt.FFlags, nfIgnorableWS);
  884. end
  885. else
  886. begin
  887. Txt := TDOMText(Child);
  888. Child := Child.NextSibling;
  889. Continue;
  890. end;
  891. end;
  892. Child.Free;
  893. Child := tmp;
  894. end
  895. else
  896. begin
  897. Child.Normalize; // should be recursive!
  898. Child := Child.NextSibling;
  899. Txt := nil;
  900. end;
  901. end;
  902. end;
  903. function TDOMNode.GetTextContent: DOMString;
  904. begin
  905. Result := NodeValue;
  906. end;
  907. procedure TDOMNode.SetTextContent(const AValue: DOMString);
  908. begin
  909. SetNodeValue(AValue);
  910. end;
  911. function TDOMNode.GetNamespaceURI: DOMString;
  912. begin
  913. Result := '';
  914. end;
  915. function TDOMNode.GetLocalName: DOMString;
  916. begin
  917. Result := '';
  918. end;
  919. function TDOMNode.GetPrefix: DOMString;
  920. begin
  921. Result := '';
  922. end;
  923. procedure TDOMNode.SetPrefix(const Value: DOMString);
  924. begin
  925. // do nothing, override for Elements and Attributes
  926. end;
  927. function TDOMNode.GetOwnerDocument: TDOMDocument;
  928. begin
  929. Result := FOwnerDocument;
  930. end;
  931. procedure TDOMNode.SetReadOnly(Value: Boolean);
  932. var
  933. child: TDOMNode;
  934. attrs: TDOMNamedNodeMap;
  935. I: Integer;
  936. begin
  937. if Value then
  938. Include(FFlags, nfReadOnly)
  939. else
  940. Exclude(FFlags, nfReadOnly);
  941. child := FirstChild;
  942. while Assigned(child) do
  943. begin
  944. child.SetReadOnly(Value);
  945. child := child.NextSibling;
  946. end;
  947. if HasAttributes then
  948. begin
  949. attrs := Attributes;
  950. for I := 0 to attrs.Length-1 do
  951. attrs[I].SetReadOnly(Value);
  952. end;
  953. end;
  954. procedure TDOMNode.Changing;
  955. begin
  956. if (nfReadOnly in FFlags) and not (nfDestroying in FOwnerDocument.FFlags) then
  957. raise EDOMError.Create(NO_MODIFICATION_ALLOWED_ERR, 'Node.CheckReadOnly');
  958. end;
  959. function CompareDOMStrings(const s1, s2: DOMPChar; l1, l2: integer): integer;
  960. var i: integer;
  961. begin
  962. Result:=l1-l2;
  963. i:=0;
  964. while (i<l1) and (Result=0) do begin
  965. Result:=ord(s1[i])-ord(s2[i]);
  966. inc(i);
  967. end;
  968. end;
  969. // generic version (slow)
  970. function TDOMNode.CompareName(const name: DOMString): Integer;
  971. var
  972. SelfName: DOMString;
  973. begin
  974. SelfName := NodeName;
  975. Result := CompareDOMStrings(DOMPChar(name), DOMPChar(SelfName), Length(name), Length(SelfName));
  976. end;
  977. // This will return nil for Entity, Notation, DocType and DocFragment's
  978. function GetAncestorElement(n: TDOMNode): TDOMElement;
  979. var
  980. parent: TDOMNode;
  981. begin
  982. case n.nodeType of
  983. DOCUMENT_NODE:
  984. result := TDOMDocument(n).documentElement;
  985. ATTRIBUTE_NODE:
  986. result := TDOMAttr(n).OwnerElement;
  987. else
  988. parent := n.ParentNode;
  989. while Assigned(parent) and (parent.NodeType <> ELEMENT_NODE) do
  990. parent := parent.ParentNode;
  991. Result := TDOMElement(parent);
  992. end;
  993. end;
  994. // TODO: specs prescribe to return default namespace if APrefix=null,
  995. // but we aren't able to distinguish null from an empty string.
  996. // This breaks level3/nodelookupnamespaceuri08 which passes an empty string.
  997. function TDOMNode.LookupNamespaceURI(const APrefix: DOMString): DOMString;
  998. var
  999. Attr: TDOMAttr;
  1000. Map: TDOMNamedNodeMap;
  1001. I: Integer;
  1002. begin
  1003. Result := '';
  1004. if Self = nil then
  1005. Exit;
  1006. if nodeType = ELEMENT_NODE then
  1007. begin
  1008. if (nfLevel2 in FFlags) and (TDOMElement(Self).Prefix = APrefix) then
  1009. begin
  1010. result := Self.NamespaceURI;
  1011. Exit;
  1012. end;
  1013. if HasAttributes then
  1014. begin
  1015. Map := Attributes;
  1016. for I := 0 to Map.Length-1 do
  1017. begin
  1018. Attr := TDOMAttr(Map[I]);
  1019. // should ignore level 1 atts here
  1020. if ((Attr.Prefix = 'xmlns') and (Attr.localName = APrefix)) or
  1021. ((Attr.localName = 'xmlns') and (APrefix = '')) then
  1022. begin
  1023. result := Attr.NodeValue;
  1024. Exit;
  1025. end;
  1026. end
  1027. end;
  1028. end;
  1029. result := GetAncestorElement(Self).LookupNamespaceURI(APrefix);
  1030. end;
  1031. function TDOMNode.LookupPrefix(const nsURI: DOMString): DOMString;
  1032. begin
  1033. Result := '';
  1034. if (nsURI = '') or (Self = nil) then
  1035. Exit;
  1036. if nodeType = ELEMENT_NODE then
  1037. result := TDOMElement(Self).InternalLookupPrefix(nsURI, TDOMElement(Self))
  1038. else
  1039. result := GetAncestorElement(Self).LookupPrefix(nsURI);
  1040. end;
  1041. function TDOMNode.IsDefaultNamespace(const nsURI: DOMString): Boolean;
  1042. var
  1043. Attr: TDOMAttr;
  1044. Map: TDOMNamedNodeMap;
  1045. I: Integer;
  1046. begin
  1047. Result := False;
  1048. if Self = nil then
  1049. Exit;
  1050. if nodeType = ELEMENT_NODE then
  1051. begin
  1052. if TDOMElement(Self).FNSI.PrefixLen = 0 then
  1053. begin
  1054. result := (nsURI = namespaceURI);
  1055. Exit;
  1056. end
  1057. else if HasAttributes then
  1058. begin
  1059. Map := Attributes;
  1060. for I := 0 to Map.Length-1 do
  1061. begin
  1062. Attr := TDOMAttr(Map[I]);
  1063. if Attr.LocalName = 'xmlns' then
  1064. begin
  1065. result := (Attr.Value = nsURI);
  1066. Exit;
  1067. end;
  1068. end;
  1069. end;
  1070. end;
  1071. result := GetAncestorElement(Self).IsDefaultNamespace(nsURI);
  1072. end;
  1073. function GetParentURI(n: TDOMNode): DOMString;
  1074. var
  1075. entity, parent: TDOMNode;
  1076. begin
  1077. parent := n.ParentNode;
  1078. if Assigned(parent) then
  1079. begin
  1080. entity := nil;
  1081. case parent.nodeType of
  1082. ENTITY_NODE:
  1083. entity := parent;
  1084. ENTITY_REFERENCE_NODE:
  1085. if Assigned(n.OwnerDocument.DocType) then
  1086. entity := n.OwnerDocument.DocType.Entities.GetNamedItem(parent.NodeName);
  1087. end;
  1088. if entity = nil then
  1089. result := parent.BaseURI
  1090. else
  1091. { TODO: this will need fix when resource resolving is implemented;
  1092. it should return the URI of actually fetched entity. }
  1093. ResolveRelativeURI(TDOMEntity(entity).FDecl.FURI, TDOMEntity(entity).SystemID, result);
  1094. end
  1095. else
  1096. result := n.OwnerDocument.DocumentURI;
  1097. end;
  1098. function TDOMNode.GetBaseURI: DOMString;
  1099. var
  1100. base: DOMString;
  1101. dtype: TDOMDocumentType;
  1102. ent: TDOMEntity;
  1103. begin
  1104. case NodeType of
  1105. ELEMENT_NODE:
  1106. begin
  1107. result := GetParentURI(Self);
  1108. { 'xml' prefix is restricted to xml namespace, so this will work
  1109. regardless of namespace processing enabled }
  1110. base := TDOMElement(Self).GetAttribute('xml:base');
  1111. if base <> '' then
  1112. begin
  1113. ResolveRelativeUri(result, base, result);
  1114. end;
  1115. end;
  1116. DOCUMENT_NODE:
  1117. result := TDOMDocument(Self).FURI;
  1118. PROCESSING_INSTRUCTION_NODE:
  1119. result := GetParentURI(Self);
  1120. { BaseUri of entities and notations is the URI where they're defined;
  1121. cloning should cause this property to get lost. }
  1122. ENTITY_NODE:
  1123. result := TDOMEntity(Self).FBaseURI;
  1124. NOTATION_NODE:
  1125. result := TDOMNotation(Self).FBaseURI;
  1126. ENTITY_REFERENCE_NODE:
  1127. begin
  1128. result := '';
  1129. dtype := OwnerDocument.DocType;
  1130. if Assigned(dtype) then
  1131. begin
  1132. ent := TDOMEntity(dtype.Entities.GetNamedItem(NodeName));
  1133. if Assigned(ent) then
  1134. result := ent.FDecl.FURI;
  1135. end;
  1136. end
  1137. else
  1138. result := '';
  1139. end;
  1140. end;
  1141. //------------------------------------------------------------------------------
  1142. type
  1143. TNodeTypeEnum = ELEMENT_NODE..NOTATION_NODE;
  1144. TNodeTypeSet = set of TNodeTypeEnum;
  1145. const
  1146. stdChildren = [TEXT_NODE, ENTITY_REFERENCE_NODE, PROCESSING_INSTRUCTION_NODE,
  1147. COMMENT_NODE, CDATA_SECTION_NODE, ELEMENT_NODE];
  1148. ValidChildren: array [TNodeTypeEnum] of TNodeTypeSet = (
  1149. stdChildren, { element }
  1150. [TEXT_NODE, ENTITY_REFERENCE_NODE], { attribute }
  1151. [], { text }
  1152. [], { cdata }
  1153. stdChildren, { ent ref }
  1154. stdChildren, { entity }
  1155. [], { pi }
  1156. [], { comment }
  1157. [ELEMENT_NODE, DOCUMENT_TYPE_NODE, PROCESSING_INSTRUCTION_NODE, COMMENT_NODE], { document }
  1158. [], { doctype }
  1159. stdChildren, { fragment }
  1160. [] { notation }
  1161. );
  1162. function TDOMNode_WithChildren.GetFirstChild: TDOMNode;
  1163. begin
  1164. Result := FFirstChild;
  1165. end;
  1166. function TDOMNode_WithChildren.GetLastChild: TDOMNode;
  1167. begin
  1168. if FFirstChild = nil then
  1169. Result := nil
  1170. else
  1171. Result := FFirstChild.FPreviousSibling;
  1172. end;
  1173. destructor TDOMNode_WithChildren.Destroy;
  1174. begin
  1175. FreeChildren;
  1176. FChildNodes.Free; // its destructor will zero the field
  1177. inherited Destroy;
  1178. end;
  1179. function TDOMNode_WithChildren.InsertBefore(NewChild, RefChild: TDOMNode):
  1180. TDOMNode;
  1181. var
  1182. Tmp: TDOMNode;
  1183. NewChildType: Integer;
  1184. begin
  1185. Result := NewChild;
  1186. NewChildType := NewChild.NodeType;
  1187. Changing;
  1188. if NewChild.FOwnerDocument <> FOwnerDocument then
  1189. begin
  1190. if (NewChildType <> DOCUMENT_TYPE_NODE) or
  1191. (NewChild.FOwnerDocument <> nil) then
  1192. raise EDOMWrongDocument.Create('NodeWC.InsertBefore');
  1193. end;
  1194. if Assigned(RefChild) and (RefChild.ParentNode <> Self) then
  1195. raise EDOMNotFound.Create('NodeWC.InsertBefore');
  1196. // TODO: skip checking Fragments as well? (Fragment itself cannot be in the tree)
  1197. if not (NewChildType in [TEXT_NODE, CDATA_SECTION_NODE, COMMENT_NODE, PROCESSING_INSTRUCTION_NODE]) and (NewChild.FirstChild <> nil) then
  1198. begin
  1199. Tmp := Self;
  1200. while Assigned(Tmp) do
  1201. begin
  1202. if Tmp = NewChild then
  1203. raise EDOMHierarchyRequest.Create('NodeWC.InsertBefore (cycle in tree)');
  1204. Tmp := Tmp.ParentNode;
  1205. end;
  1206. end;
  1207. if NewChild = RefChild then // inserting node before itself is a no-op
  1208. Exit;
  1209. Inc(FOwnerDocument.FRevision); // invalidate nodelists
  1210. if NewChildType = DOCUMENT_FRAGMENT_NODE then
  1211. begin
  1212. Tmp := NewChild.FirstChild;
  1213. if Assigned(Tmp) then
  1214. begin
  1215. while Assigned(Tmp) do
  1216. begin
  1217. if not (Tmp.NodeType in ValidChildren[NodeType]) then
  1218. raise EDOMHierarchyRequest.Create('NodeWC.InsertBefore');
  1219. Tmp := Tmp.NextSibling;
  1220. end;
  1221. while Assigned(TDOMDocumentFragment(NewChild).FFirstChild) do
  1222. InsertBefore(TDOMDocumentFragment(NewChild).FFirstChild, RefChild);
  1223. end;
  1224. Exit;
  1225. end;
  1226. if not (NewChildType in ValidChildren[NodeType]) then
  1227. raise EDOMHierarchyRequest.Create('NodeWC.InsertBefore');
  1228. if Assigned(NewChild.FParentNode) then
  1229. NewChild.FParentNode.DetachChild(NewChild);
  1230. NewChild.FNextSibling := RefChild;
  1231. if RefChild = nil then // append to the end
  1232. begin
  1233. if Assigned(FFirstChild) then
  1234. begin
  1235. Tmp := FFirstChild.FPreviousSibling; { our last child }
  1236. Tmp.FNextSibling := NewChild;
  1237. NewChild.FPreviousSibling := Tmp;
  1238. end
  1239. else
  1240. begin
  1241. FFirstChild := NewChild;
  1242. Include(NewChild.FFlags, nfFirstChild);
  1243. end;
  1244. FFirstChild.FPreviousSibling := NewChild; { becomes our last child }
  1245. end
  1246. else // insert before RefChild
  1247. begin
  1248. NewChild.FPreviousSibling := RefChild.FPreviousSibling;
  1249. if RefChild = FFirstChild then
  1250. begin
  1251. Exclude(RefChild.FFlags, nfFirstChild);
  1252. FFirstChild := NewChild;
  1253. Include(NewChild.FFlags, nfFirstChild);
  1254. end
  1255. else
  1256. RefChild.FPreviousSibling.FNextSibling := NewChild;
  1257. RefChild.FPreviousSibling := NewChild;
  1258. end;
  1259. NewChild.FParentNode := Self;
  1260. end;
  1261. function TDOMNode_WithChildren.ReplaceChild(NewChild, OldChild: TDOMNode):
  1262. TDOMNode;
  1263. begin
  1264. InsertBefore(NewChild, OldChild);
  1265. if Assigned(OldChild) and (OldChild <> NewChild) then
  1266. RemoveChild(OldChild);
  1267. Result := OldChild;
  1268. end;
  1269. function TDOMNode_WithChildren.DetachChild(OldChild: TDOMNode): TDOMNode;
  1270. var
  1271. prev, next: TDOMNode;
  1272. begin
  1273. Changing;
  1274. if OldChild.ParentNode <> Self then
  1275. raise EDOMNotFound.Create('NodeWC.RemoveChild');
  1276. Inc(FOwnerDocument.FRevision); // invalidate nodelists
  1277. if OldChild = FFirstChild then
  1278. begin
  1279. Exclude(OldChild.FFlags, nfFirstChild);
  1280. FFirstChild := FFirstChild.FNextSibling;
  1281. if Assigned(FFirstChild) then
  1282. begin
  1283. { maintain lastChild }
  1284. Include(FFirstChild.FFlags, nfFirstChild);
  1285. FFirstChild.FPreviousSibling := OldChild.FPreviousSibling;
  1286. end;
  1287. end
  1288. else
  1289. begin
  1290. prev := OldChild.FPreviousSibling;
  1291. next := OldChild.FNextSibling;
  1292. prev.FNextSibling := next;
  1293. if Assigned(next) then { removing node in the middle }
  1294. next.FPreviousSibling := prev
  1295. else { removing the last child }
  1296. FFirstChild.FPreviousSibling := prev;
  1297. end;
  1298. // Make sure removed child does not contain references to nowhere
  1299. OldChild.FPreviousSibling := nil;
  1300. OldChild.FNextSibling := nil;
  1301. OldChild.FParentNode := nil;
  1302. Result := OldChild;
  1303. end;
  1304. procedure TDOMNode_WithChildren.InternalAppend(NewChild: TDOMNode);
  1305. var
  1306. Tmp: TDOMNode;
  1307. begin
  1308. if Assigned(FFirstChild) then
  1309. begin
  1310. Tmp := FFirstChild.FPreviousSibling; { our last child }
  1311. Tmp.FNextSibling := NewChild;
  1312. NewChild.FPreviousSibling := Tmp;
  1313. end
  1314. else
  1315. begin
  1316. FFirstChild := NewChild;
  1317. Include(NewChild.FFlags, nfFirstChild);
  1318. end;
  1319. FFirstChild.FPreviousSibling := NewChild; { becomes our last child }
  1320. NewChild.FParentNode := Self;
  1321. end;
  1322. function TDOMNode_WithChildren.HasChildNodes: Boolean;
  1323. begin
  1324. Result := Assigned(FFirstChild);
  1325. end;
  1326. function TDOMNode_WithChildren.FindNode(const ANodeName: DOMString): TDOMNode;
  1327. begin
  1328. Result := FFirstChild;
  1329. while Assigned(Result) do
  1330. begin
  1331. if Result.CompareName(ANodeName)=0 then
  1332. Exit;
  1333. Result := Result.NextSibling;
  1334. end;
  1335. end;
  1336. procedure TDOMNode_WithChildren.CloneChildren(ACopy: TDOMNode;
  1337. ACloneOwner: TDOMDocument);
  1338. var
  1339. node: TDOMNode;
  1340. begin
  1341. node := FirstChild;
  1342. while Assigned(node) do
  1343. begin
  1344. TDOMNode_WithChildren(ACopy).InternalAppend(node.CloneNode(True, ACloneOwner));
  1345. node := node.NextSibling;
  1346. end;
  1347. end;
  1348. procedure TDOMNode_WithChildren.FreeChildren;
  1349. var
  1350. child, next: TDOMNode;
  1351. begin
  1352. child := FFirstChild;
  1353. while Assigned(child) do
  1354. begin
  1355. next := child.NextSibling;
  1356. child.FParentNode := nil;
  1357. child.Destroy; // we know it's not nil, so save a call
  1358. child := next;
  1359. end;
  1360. FFirstChild := nil;
  1361. end;
  1362. function TDOMNode_WithChildren.GetTextContent: DOMString;
  1363. var
  1364. child: TDOMNode;
  1365. begin
  1366. Result := '';
  1367. child := FFirstChild;
  1368. // TODO: probably very slow, optimization needed
  1369. while Assigned(child) do
  1370. begin
  1371. case child.NodeType of
  1372. TEXT_NODE: if not (nfIgnorableWS in child.FFlags) then
  1373. Result := Result + TDOMText(child).Data;
  1374. COMMENT_NODE, PROCESSING_INSTRUCTION_NODE: ; // ignored
  1375. else
  1376. Result := Result + child.TextContent;
  1377. end;
  1378. child := child.NextSibling;
  1379. end;
  1380. end;
  1381. procedure TDOMNode_WithChildren.SetTextContent(const AValue: DOMString);
  1382. begin
  1383. Changing;
  1384. while Assigned(FFirstChild) do
  1385. DetachChild(FFirstChild);
  1386. if AValue <> '' then
  1387. AppendChild(FOwnerDocument.CreateTextNode(AValue));
  1388. end;
  1389. // -------------------------------------------------------
  1390. // NodeList
  1391. // -------------------------------------------------------
  1392. constructor TDOMNodeList.Create(ANode: TDOMNode);
  1393. begin
  1394. inherited Create;
  1395. FNode := ANode;
  1396. FRevision := ANode.GetRevision-1; // force BuildList at first access
  1397. FList := TFPList.Create;
  1398. end;
  1399. destructor TDOMNodeList.Destroy;
  1400. begin
  1401. if (FNode is TDOMNode_WithChildren) and
  1402. (TDOMNode_WithChildren(FNode).FChildNodes = Self) then
  1403. TDOMNode_WithChildren(FNode).FChildNodes := nil
  1404. else
  1405. FNode.FOwnerDocument.NodeListDestroyed(Self);
  1406. FList.Free;
  1407. inherited Destroy;
  1408. end;
  1409. function TDOMNodeList.NodeFilter(aNode: TDOMNode): TFilterResult;
  1410. begin
  1411. // accept all nodes but don't allow recursion
  1412. Result := frNorecurseTrue;
  1413. end;
  1414. procedure TDOMNodeList.BuildList;
  1415. var
  1416. current, next: TDOMNode;
  1417. res: TFilterResult;
  1418. begin
  1419. FList.Clear;
  1420. FRevision := FNode.GetRevision; // refresh
  1421. current := FNode.FirstChild;
  1422. while Assigned(current) do
  1423. begin
  1424. res := NodeFilter(current);
  1425. if res in [frTrue, frNorecurseTrue] then
  1426. FList.Add(current);
  1427. next := nil;
  1428. if res in [frTrue, frFalse] then
  1429. next := current.FirstChild;
  1430. if next = nil then
  1431. begin
  1432. while current <> FNode do
  1433. begin
  1434. next := current.NextSibling;
  1435. if Assigned(next) then
  1436. Break;
  1437. current := current.ParentNode;
  1438. end;
  1439. end;
  1440. current := next;
  1441. end;
  1442. end;
  1443. function TDOMNodeList.GetCount: LongWord;
  1444. begin
  1445. if FRevision <> FNode.GetRevision then
  1446. BuildList;
  1447. Result := FList.Count;
  1448. end;
  1449. function TDOMNodeList.GetItem(index: LongWord): TDOMNode;
  1450. begin
  1451. if FRevision <> FNode.GetRevision then
  1452. BuildList;
  1453. if index < LongWord(FList.Count) then
  1454. Result := TDOMNode(FList.List^[index])
  1455. else
  1456. Result := nil;
  1457. end;
  1458. { TDOMElementList }
  1459. constructor TDOMElementList.Create(ANode: TDOMNode; const AFilter: DOMString);
  1460. begin
  1461. inherited Create(ANode);
  1462. filter := AFilter;
  1463. UseFilter := filter <> '*';
  1464. end;
  1465. constructor TDOMElementList.Create(ANode: TDOMNode; const nsURI, localName: DOMString);
  1466. begin
  1467. inherited Create(ANode);
  1468. localNameFilter := localName;
  1469. FMatchNS := True;
  1470. FMatchAnyNS := (nsURI = '*');
  1471. if not FMatchAnyNS then
  1472. FNSIndexFilter := ANode.FOwnerDocument.IndexOfNS(nsURI);
  1473. UseFilter := (localName <> '*');
  1474. end;
  1475. function TDOMElementList.NodeFilter(aNode: TDOMNode): TFilterResult;
  1476. var
  1477. I, L: Integer;
  1478. begin
  1479. Result := frFalse;
  1480. if aNode.NodeType = ELEMENT_NODE then with TDOMElement(aNode) do
  1481. begin
  1482. if FMatchNS then
  1483. begin
  1484. if (FMatchAnyNS or (FNSI.NSIndex = Word(FNSIndexFilter))) then
  1485. begin
  1486. I := FNSI.PrefixLen;
  1487. L := system.Length(FNSI.QName^.Key);
  1488. if (not UseFilter or ((L-I = system.Length(localNameFilter)) and
  1489. CompareMem(@FNSI.QName^.Key[I+1], DOMPChar(localNameFilter), system.Length(localNameFilter)*sizeof(WideChar)))) then
  1490. Result := frTrue;
  1491. end;
  1492. end
  1493. else if (not UseFilter or (TagName = Filter)) then
  1494. Result := frTrue;
  1495. end;
  1496. end;
  1497. // -------------------------------------------------------
  1498. // NamedNodeMap
  1499. // -------------------------------------------------------
  1500. constructor TDOMNamedNodeMap.Create(AOwner: TDOMNode);
  1501. begin
  1502. inherited Create;
  1503. FOwner := AOwner;
  1504. FList := TFPList.Create;
  1505. end;
  1506. destructor TDOMNamedNodeMap.Destroy;
  1507. var
  1508. I: Integer;
  1509. begin
  1510. for I := FList.Count-1 downto 0 do
  1511. TDOMNode(FList.List^[I]).Free;
  1512. FList.Free;
  1513. inherited Destroy;
  1514. end;
  1515. function TDOMNamedNodeMap.GetItem(index: LongWord): TDOMNode;
  1516. begin
  1517. if index < LongWord(FList.Count) then
  1518. Result := TDOMNode(FList.List^[index])
  1519. else
  1520. Result := nil;
  1521. end;
  1522. function TDOMNamedNodeMap.GetLength: LongWord;
  1523. begin
  1524. Result := FList.Count;
  1525. end;
  1526. function TDOMNamedNodeMap.Find(const name: DOMString; out Index: LongWord): Boolean;
  1527. var
  1528. L, H, I, C: Integer;
  1529. begin
  1530. Result := False;
  1531. L := 0;
  1532. H := FList.Count - 1;
  1533. while L <= H do
  1534. begin
  1535. I := (L + H) shr 1;
  1536. C := TDOMNode(FList.List^[I]).CompareName(name);
  1537. if C > 0 then L := I + 1 else
  1538. begin
  1539. H := I - 1;
  1540. if C = 0 then
  1541. begin
  1542. Result := True;
  1543. L := I;
  1544. end;
  1545. end;
  1546. end;
  1547. Index := L;
  1548. end;
  1549. function TDOMNamedNodeMap.GetNamedItem(const name: DOMString): TDOMNode;
  1550. var
  1551. i: Cardinal;
  1552. begin
  1553. if Find(name, i) then
  1554. Result := TDOMNode(FList.List^[i])
  1555. else
  1556. Result := nil;
  1557. end;
  1558. // Note: this *may* raise NOT_SUPPORTED_ERR if the document is e.g. HTML.
  1559. // This isn't checked now.
  1560. function TDOMNamedNodeMap.GetNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode;
  1561. begin
  1562. Result := nil;
  1563. end;
  1564. function TDOMNamedNodeMap.ValidateInsert(arg: TDOMNode): Integer;
  1565. begin
  1566. Result := 0;
  1567. if nfReadOnly in FOwner.FFlags then
  1568. Result := NO_MODIFICATION_ALLOWED_ERR
  1569. else if arg.FOwnerDocument <> FOwner.FOwnerDocument then
  1570. Result := WRONG_DOCUMENT_ERR;
  1571. { Note: Since Entity and Notation maps are always read-only, and the AttributeMap
  1572. overrides this method and does its own check for correct arg.NodeType, there's
  1573. no point in checking NodeType here. }
  1574. end;
  1575. function TDOMNamedNodeMap.SetNamedItem(arg: TDOMNode): TDOMNode;
  1576. var
  1577. i: Cardinal;
  1578. Exists: Boolean;
  1579. res: Integer;
  1580. begin
  1581. res := ValidateInsert(arg);
  1582. if res <> 0 then
  1583. raise EDOMError.Create(res, 'NamedNodeMap.SetNamedItem');
  1584. Exists := Find(arg.NodeName, i);
  1585. if Exists then
  1586. begin
  1587. Result := TDOMNode(FList.List^[i]);
  1588. FList.List^[i] := arg;
  1589. exit;
  1590. end;
  1591. FList.Insert(i, arg);
  1592. Result := nil;
  1593. end;
  1594. function TDOMNamedNodeMap.SetNamedItemNS(arg: TDOMNode): TDOMNode;
  1595. begin
  1596. { Since the map contains only namespaceless nodes (all having empty
  1597. localName and namespaceURI properties), a namespaced arg won't match
  1598. any of them. Therefore, add it using nodeName as key.
  1599. Note: a namespaceless arg is another story, as it will match *any* node
  1600. in the map. This can be considered as a flaw in specs. }
  1601. Result := SetNamedItem(arg);
  1602. end;
  1603. function TDOMNamedNodeMap.Delete(index: LongWord): TDOMNode;
  1604. begin
  1605. Result := TDOMNode(FList.List^[index]);
  1606. FList.Delete(index);
  1607. end;
  1608. function TDOMNamedNodeMap.InternalRemove(const name: DOMString): TDOMNode;
  1609. var
  1610. i: Cardinal;
  1611. begin
  1612. if Find(name, i) then
  1613. Result := Delete(I)
  1614. else
  1615. Result := nil;
  1616. end;
  1617. function TDOMNamedNodeMap.RemoveNamedItem(const name: DOMString): TDOMNode;
  1618. begin
  1619. if nfReadOnly in FOwner.FFlags then
  1620. raise EDOMError.Create(NO_MODIFICATION_ALLOWED_ERR, 'NamedNodeMap.RemoveNamedItem');
  1621. Result := InternalRemove(name);
  1622. if Result = nil then
  1623. raise EDOMNotFound.Create('NamedNodeMap.RemoveNamedItem');
  1624. end;
  1625. function TDOMNamedNodeMap.RemoveNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode;
  1626. begin
  1627. // see comments to SetNamedItemNS. Related tests are written clever enough
  1628. // in the sense they don't expect NO_MODIFICATION_ERR in first place.
  1629. raise EDOMNotFound.Create('NamedNodeMap.RemoveNamedItemNS');
  1630. Result := nil;
  1631. end;
  1632. { TAttributeMap }
  1633. function TAttributeMap.Delete(index: LongWord): TDOMNode;
  1634. begin
  1635. Result := inherited Delete(index);
  1636. if Assigned(Result) then
  1637. begin
  1638. Result.FParentNode := nil;
  1639. if Assigned(TDOMAttr(Result).FNSI.QName) then
  1640. RestoreDefault(TDOMAttr(Result).FNSI.QName);
  1641. end;
  1642. end;
  1643. function TAttributeMap.ValidateInsert(arg: TDOMNode): Integer;
  1644. begin
  1645. Result := inherited ValidateInsert(arg);
  1646. if Result = 0 then
  1647. begin
  1648. if arg.NodeType <> ATTRIBUTE_NODE then
  1649. Result := HIERARCHY_REQUEST_ERR
  1650. else if Assigned(arg.FParentNode) and (arg.FParentNode <> FOwner) then
  1651. Result := INUSE_ATTRIBUTE_ERR;
  1652. end;
  1653. end;
  1654. procedure TAttributeMap.RestoreDefault(aName: PHashItem);
  1655. var
  1656. eldef: TElementDecl;
  1657. attrdef: TAttributeDef;
  1658. begin
  1659. if not Assigned(TDOMElement(FOwner).FNSI.QName) then // safeguard
  1660. Exit;
  1661. eldef := TElementDecl(TDOMElement(FOwner).FNSI.QName^.Data);
  1662. if Assigned(eldef) then
  1663. begin
  1664. // TODO: can be avoided by linking attributes directly to their defs
  1665. attrdef := eldef.GetAttrDef(aName);
  1666. if Assigned(attrdef) and (attrdef.Default in [adDefault, adFixed]) then
  1667. TDOMElement(FOwner).RestoreDefaultAttr(attrdef);
  1668. end;
  1669. end;
  1670. // Since list is kept sorted by nodeName, we must use linear search here.
  1671. // This routine is not called while parsing, so parsing speed is not lowered.
  1672. function TAttributeMap.FindNS(nsIndex: Integer; const aLocalName: DOMString;
  1673. out Index: LongWord): Boolean;
  1674. var
  1675. I: Integer;
  1676. P: DOMPChar;
  1677. begin
  1678. for I := 0 to FList.Count-1 do
  1679. begin
  1680. with TDOMAttr(FList.List^[I]) do
  1681. begin
  1682. if nsIndex = FNSI.NSIndex then
  1683. begin
  1684. P := DOMPChar(FNSI.QName^.Key);
  1685. if FNSI.PrefixLen > 1 then
  1686. Inc(P, FNSI.PrefixLen);
  1687. if CompareDOMStrings(DOMPChar(aLocalName), P, System.Length(aLocalName), System.Length(FNSI.QName^.Key) - FNSI.PrefixLen) = 0 then
  1688. begin
  1689. Index := I;
  1690. Result := True;
  1691. Exit;
  1692. end;
  1693. end;
  1694. end;
  1695. end;
  1696. Result := False;
  1697. end;
  1698. function TAttributeMap.InternalRemoveNS(const nsURI, aLocalName: DOMString): TDOMNode;
  1699. var
  1700. i: Cardinal;
  1701. nsIndex: Integer;
  1702. begin
  1703. Result := nil;
  1704. nsIndex := FOwner.FOwnerDocument.IndexOfNS(nsURI);
  1705. if (nsIndex >= 0) and FindNS(nsIndex, aLocalName, i) then
  1706. Result := Delete(I);
  1707. end;
  1708. function TAttributeMap.getNamedItemNS(const namespaceURI, localName: DOMString): TDOMNode;
  1709. var
  1710. nsIndex: Integer;
  1711. i: LongWord;
  1712. begin
  1713. nsIndex := FOwner.FOwnerDocument.IndexOfNS(namespaceURI);
  1714. if (nsIndex >= 0) and FindNS(nsIndex, localName, i) then
  1715. Result := TDOMNode(FList.List^[i])
  1716. else
  1717. Result := nil;
  1718. end;
  1719. function TAttributeMap.setNamedItem(arg: TDOMNode): TDOMNode;
  1720. begin
  1721. Result := inherited setNamedItem(arg);
  1722. if Assigned(Result) then
  1723. Result.FParentNode := nil;
  1724. arg.FParentNode := FOwner;
  1725. end;
  1726. function TAttributeMap.setNamedItemNS(arg: TDOMNode): TDOMNode;
  1727. var
  1728. i: LongWord;
  1729. res: Integer;
  1730. Exists: Boolean;
  1731. begin
  1732. res := ValidateInsert(arg);
  1733. if res <> 0 then
  1734. raise EDOMError.Create(res, 'NamedNodeMap.SetNamedItemNS');
  1735. Result := nil;
  1736. with TDOMAttr(arg) do
  1737. begin
  1738. // calling LocalName is no good... but it is done once
  1739. if FindNS(FNSI.NSIndex, localName, i) then
  1740. begin
  1741. Result := TDOMNode(FList.List^[i]);
  1742. FList.Delete(i);
  1743. end;
  1744. // Do a non-namespace search in order to keep the list sorted on nodeName
  1745. Exists := Find(FNSI.QName^.Key, i);
  1746. if Exists and (Result = nil) then // case when arg has no namespace
  1747. begin
  1748. Result := TDOMNode(FList.List^[i]);
  1749. FList.List^[i] := arg;
  1750. end
  1751. else
  1752. FList.Insert(i, arg);
  1753. end;
  1754. if Assigned(Result) then
  1755. Result.FParentNode := nil;
  1756. arg.FParentNode := FOwner;
  1757. end;
  1758. function TAttributeMap.removeNamedItemNS(const namespaceURI,
  1759. localName: DOMString): TDOMNode;
  1760. begin
  1761. if nfReadOnly in FOwner.FFlags then
  1762. raise EDOMError.Create(NO_MODIFICATION_ALLOWED_ERR, 'NamedNodeMap.RemoveNamedItemNS');
  1763. Result := InternalRemoveNS(namespaceURI, localName);
  1764. if Result = nil then
  1765. raise EDOMNotFound.Create('NamedNodeMap.RemoveNamedItemNS');
  1766. end;
  1767. // -------------------------------------------------------
  1768. // CharacterData
  1769. // -------------------------------------------------------
  1770. function TDOMCharacterData.GetLength: LongWord;
  1771. begin
  1772. Result := system.Length(FNodeValue);
  1773. end;
  1774. function TDOMCharacterData.GetNodeValue: DOMString;
  1775. begin
  1776. Result := FNodeValue;
  1777. end;
  1778. procedure TDOMCharacterData.SetNodeValue(const AValue: DOMString);
  1779. begin
  1780. Changing;
  1781. FNodeValue := AValue;
  1782. end;
  1783. function TDOMCharacterData.SubstringData(offset, count: LongWord): DOMString;
  1784. begin
  1785. if offset > Length then
  1786. raise EDOMIndexSize.Create('CharacterData.SubstringData');
  1787. Result := Copy(FNodeValue, offset + 1, count);
  1788. end;
  1789. procedure TDOMCharacterData.AppendData(const arg: DOMString);
  1790. begin
  1791. Changing;
  1792. FNodeValue := FNodeValue + arg;
  1793. end;
  1794. procedure TDOMCharacterData.InsertData(offset: LongWord; const arg: DOMString);
  1795. begin
  1796. Changing;
  1797. if offset > Length then
  1798. raise EDOMIndexSize.Create('CharacterData.InsertData');
  1799. Insert(arg, FNodeValue, offset+1);
  1800. end;
  1801. procedure TDOMCharacterData.DeleteData(offset, count: LongWord);
  1802. begin
  1803. Changing;
  1804. if offset > Length then
  1805. raise EDOMIndexSize.Create('CharacterData.DeleteData');
  1806. Delete(FNodeValue, offset+1, count);
  1807. end;
  1808. procedure TDOMCharacterData.ReplaceData(offset, count: LongWord; const arg: DOMString);
  1809. begin
  1810. DeleteData(offset, count);
  1811. InsertData(offset, arg);
  1812. end;
  1813. // -------------------------------------------------------
  1814. // DocumentFragmet
  1815. // -------------------------------------------------------
  1816. function TDOMDocumentFragment.GetNodeType: Integer;
  1817. begin
  1818. Result := DOCUMENT_FRAGMENT_NODE;
  1819. end;
  1820. function TDOMDocumentFragment.GetNodeName: DOMString;
  1821. begin
  1822. Result := '#document-fragment';
  1823. end;
  1824. function TDOMDocumentFragment.CloneNode(deep: Boolean; aCloneOwner: TDOMDocument): TDOMNode;
  1825. begin
  1826. Result := aCloneOwner.CreateDocumentFragment;
  1827. if deep then
  1828. CloneChildren(Result, aCloneOwner);
  1829. end;
  1830. // -------------------------------------------------------
  1831. // Top-level node
  1832. // -------------------------------------------------------
  1833. function TDOMNode_TopLevel.GetXMLVersion: DOMString;
  1834. begin
  1835. Result := xmlVersionStr[FXMLVersion];
  1836. end;
  1837. // -------------------------------------------------------
  1838. // DOMImplementation
  1839. // -------------------------------------------------------
  1840. { if nsIdx = -1, checks only the name. Otherwise additionally checks if the prefix is
  1841. valid for standard namespace specified by nsIdx.
  1842. Non-negative return value is Pos(':', QName), negative is DOM error code. }
  1843. function CheckQName(const QName: DOMString; nsIdx: Integer): Integer;
  1844. var
  1845. I, L: Integer;
  1846. begin
  1847. if not IsXmlName(QName) then
  1848. begin
  1849. Result := -INVALID_CHARACTER_ERR;
  1850. Exit;
  1851. end;
  1852. L := Length(QName);
  1853. Result := Pos(WideChar(':'), QName);
  1854. if Result > 0 then
  1855. begin
  1856. for I := Result+1 to L-1 do // check for second colon (Use IndexWord?)
  1857. if QName[I] = ':' then
  1858. begin
  1859. Result := -NAMESPACE_ERR;
  1860. Exit;
  1861. end;
  1862. // Name validity has already been checked by IsXmlName() call above.
  1863. // So just check that colon isn't first or last char, and that it is follwed by NameStartChar.
  1864. if ((Result = 1) or (Result = L) or not IsXmlName(@QName[Result+1], 1)) then
  1865. begin
  1866. Result := -NAMESPACE_ERR;
  1867. Exit;
  1868. end;
  1869. end;
  1870. if nsIdx < 0 then Exit;
  1871. // QName contains prefix, but no namespace
  1872. if ((nsIdx = 0) and (Result > 0)) or
  1873. // Bad usage of 'http://www.w3.org/2000/xmlns/'
  1874. ((((L = 5) or (Result = 6)) and (Pos(DOMString('xmlns'), QName) = 1)) <> (nsIdx = 2)) or
  1875. // Bad usage of 'http://www.w3.org/XML/1998/namespace'
  1876. ((Result = 4) and (Pos(DOMString('xml'), QName) = 1) and (nsIdx <> 1)) then
  1877. Result := -NAMESPACE_ERR;
  1878. end;
  1879. function TDOMImplementation.HasFeature(const feature, version: DOMString):
  1880. Boolean;
  1881. var
  1882. s: string;
  1883. begin
  1884. s := feature; // force Ansi, features do not contain non-ASCII chars
  1885. Result := (SameText(s, 'XML') and ((version = '') or (version = '1.0') or (version = '2.0'))) or
  1886. (SameText(s, 'Core') and ((version = '') or (version = '2.0')));
  1887. end;
  1888. function TDOMImplementation.CreateDocumentType(const QualifiedName, PublicID,
  1889. SystemID: DOMString): TDOMDocumentType;
  1890. var
  1891. res: Integer;
  1892. model: TDTDModel;
  1893. begin
  1894. res := CheckQName(QualifiedName, -1);
  1895. if res < 0 then
  1896. raise EDOMError.Create(-res, 'Implementation.CreateDocumentType');
  1897. model := TDTDModel.Create(nil); // !!nowhere to get nametable from at this time
  1898. model.FName := QualifiedName;
  1899. // DOM does not restrict PublicID without SystemID (unlike XML spec)
  1900. model.FPublicID := PublicID;
  1901. model.FSystemID := SystemID;
  1902. Result := TDOMDocumentType.Create(nil, model);
  1903. model.Release; // now Result remains a sole owner of model
  1904. end;
  1905. function TDOMImplementation.CreateDocument(const NamespaceURI,
  1906. QualifiedName: DOMString; doctype: TDOMDocumentType): TDOMDocument;
  1907. var
  1908. Root: TDOMNode;
  1909. begin
  1910. if Assigned(doctype) and Assigned(doctype.OwnerDocument) then
  1911. raise EDOMWrongDocument.Create('Implementation.CreateDocument');
  1912. Result := TXMLDocument.Create;
  1913. Result.FImplementation := Self;
  1914. try
  1915. if Assigned(doctype) then
  1916. begin
  1917. Doctype.FOwnerDocument := Result;
  1918. Result.AppendChild(doctype);
  1919. end;
  1920. Root := Result.CreateElementNS(NamespaceURI, QualifiedName);
  1921. Result.AppendChild(Root);
  1922. except
  1923. Result.Free;
  1924. raise;
  1925. end;
  1926. end;
  1927. // -------------------------------------------------------
  1928. // Document
  1929. // -------------------------------------------------------
  1930. constructor TDOMDocument.Create;
  1931. begin
  1932. inherited Create(nil);
  1933. FOwnerDocument := Self;
  1934. FMaxPoolSize := (TDOMEntity.InstanceSize + sizeof(Pointer)-1) and not (sizeof(Pointer)-1) + sizeof(Pointer);
  1935. FPools := AllocMem(FMaxPoolSize);
  1936. FNames := THashTable.Create(256, True);
  1937. SetLength(FNamespaces, 3);
  1938. // Namespace #0 should always be an empty string
  1939. FNamespaces[1] := stduri_xml;
  1940. FNamespaces[2] := stduri_xmlns;
  1941. FEmptyNode := TDOMElement.Create(Self);
  1942. end;
  1943. destructor TDOMDocument.Destroy;
  1944. var
  1945. i: Integer;
  1946. begin
  1947. Include(FFlags, nfDestroying);
  1948. FreeAndNil(FIDList); // set to nil before starting destroying children
  1949. FNodeLists.Free;
  1950. FEmptyNode.Free;
  1951. inherited Destroy;
  1952. for i := 0 to (FMaxPoolSize div sizeof(TNodePool))-1 do
  1953. FPools^[i].Free;
  1954. FreeMem(FPools);
  1955. FNames.Free; // free the nametable after inherited has destroyed the children
  1956. // (because children reference the nametable)
  1957. end;
  1958. function TDOMDocument.CloneNode(deep: Boolean): TDOMNode;
  1959. type
  1960. TDOMDocumentClass = class of TDOMDocument;
  1961. var
  1962. Clone: TDOMDocument;
  1963. node, doctypenode: TDOMNode;
  1964. begin
  1965. Clone := TDOMDocumentClass(ClassType).Create;
  1966. Clone.FInputEncoding := FInputEncoding;
  1967. Clone.FXMLEncoding := FXMLEncoding;
  1968. Clone.FXMLVersion := FXMLVersion;
  1969. Clone.FXMLStandalone := FXMLStandalone;
  1970. Clone.FURI := FURI;
  1971. if deep then
  1972. begin
  1973. node := FirstChild;
  1974. doctypenode := DocType;
  1975. while Assigned(node) do
  1976. begin
  1977. {TODO: now just skip doctype, a better solution is to be found.}
  1978. if node <> doctypenode then
  1979. Clone.InternalAppend(node.CloneNode(True, Clone));
  1980. node := node.NextSibling;
  1981. end;
  1982. end;
  1983. Result := Clone;
  1984. end;
  1985. function TDOMDocument.Alloc(AClass: TDOMNodeClass): TDOMNode;
  1986. var
  1987. pp: TNodePool;
  1988. size: Integer;
  1989. begin
  1990. if nfDestroying in FFlags then
  1991. raise EDOMError.Create(INVALID_ACCESS_ERR, 'Attempt to allocate node memory while destroying');
  1992. size := (AClass.InstanceSize + sizeof(Pointer)-1) and not (sizeof(Pointer)-1);
  1993. if size > FMaxPoolSize then
  1994. begin
  1995. Result := TDOMNode(AClass.NewInstance);
  1996. Exit;
  1997. end;
  1998. pp := FPools^[size div sizeof(TNodePool)];
  1999. if pp = nil then
  2000. begin
  2001. pp := TNodePool.Create(size);
  2002. FPools^[size div sizeof(TNodePool)] := pp;
  2003. end;
  2004. Result := pp.AllocNode(AClass);
  2005. end;
  2006. // This shouldn't be called if document has no IDs,
  2007. // or when it is being destroyed
  2008. // TODO: This could be much faster if removing ID happens
  2009. // upon modification of corresponding attribute value.
  2010. procedure TDOMDocument.RemoveID(Elem: TDOMElement);
  2011. begin
  2012. FIDList.RemoveData(Elem);
  2013. end;
  2014. function TDOMDocument.GetNodeType: Integer;
  2015. begin
  2016. Result := DOCUMENT_NODE;
  2017. end;
  2018. function TDOMDocument.GetNodeName: DOMString;
  2019. begin
  2020. Result := '#document';
  2021. end;
  2022. function TDOMDocument.GetTextContent: DOMString;
  2023. begin
  2024. Result := '';
  2025. end;
  2026. procedure TDOMDocument.SetTextContent(const value: DOMString);
  2027. begin
  2028. // Document ignores setting TextContent
  2029. end;
  2030. function TDOMDocument.GetOwnerDocument: TDOMDocument;
  2031. begin
  2032. Result := nil;
  2033. end;
  2034. function TDOMDocument.InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode;
  2035. var
  2036. nType: Integer;
  2037. begin
  2038. nType := NewChild.NodeType;
  2039. if ((nType = ELEMENT_NODE) and Assigned(DocumentElement)) or
  2040. ((nType = DOCUMENT_TYPE_NODE) and Assigned(DocType)) then
  2041. raise EDOMHierarchyRequest.Create('Document.InsertBefore');
  2042. Result := inherited InsertBefore(NewChild, RefChild);
  2043. end;
  2044. function TDOMDocument.ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode;
  2045. var
  2046. nType: Integer;
  2047. begin
  2048. nType := NewChild.NodeType;
  2049. if ((nType = ELEMENT_NODE) and (OldChild = DocumentElement)) or // root can be replaced by another element
  2050. ((nType = DOCUMENT_TYPE_NODE) and (OldChild = DocType)) then // and so can be DTD
  2051. begin
  2052. inherited InsertBefore(NewChild, OldChild);
  2053. Result := OldChild;
  2054. if OldChild <> NewChild then
  2055. RemoveChild(OldChild);
  2056. end
  2057. else
  2058. Result := inherited ReplaceChild(NewChild, OldChild);
  2059. end;
  2060. function TDOMDocument.GetDocumentElement: TDOMElement;
  2061. var
  2062. node: TDOMNode;
  2063. begin
  2064. node := FFirstChild;
  2065. while Assigned(node) and (node.NodeType <> ELEMENT_NODE) do
  2066. node := node.NextSibling;
  2067. Result := TDOMElement(node);
  2068. end;
  2069. function TDOMDocument.GetDocType: TDOMDocumentType;
  2070. var
  2071. node: TDOMNode;
  2072. begin
  2073. node := FFirstChild;
  2074. while Assigned(node) and (node.NodeType <> DOCUMENT_TYPE_NODE) do
  2075. node := node.NextSibling;
  2076. Result := TDOMDocumentType(node);
  2077. end;
  2078. function TDOMDocument.CreateElement(const tagName: DOMString): TDOMElement;
  2079. begin
  2080. if not IsXmlName(tagName) then
  2081. raise EDOMError.Create(INVALID_CHARACTER_ERR, 'DOMDocument.CreateElement');
  2082. TDOMNode(Result) := Alloc(TDOMElement);
  2083. Result.Create(Self);
  2084. Result.FNSI.QName := FNames.FindOrAdd(DOMPChar(tagName), Length(tagName));
  2085. Result.AttachDefaultAttrs;
  2086. end;
  2087. function TDOMDocument.CreateElementBuf(Buf: DOMPChar; Length: Integer): TDOMElement;
  2088. begin
  2089. TDOMNode(Result) := Alloc(TDOMElement);
  2090. Result.Create(Self);
  2091. Result.FNSI.QName := FNames.FindOrAdd(Buf, Length);
  2092. end;
  2093. function TDOMDocument.CreateDocumentFragment: TDOMDocumentFragment;
  2094. begin
  2095. TDOMNode(Result) := Alloc(TDOMDocumentFragment);
  2096. Result.Create(Self);
  2097. end;
  2098. function TDOMDocument.CreateTextNode(const data: DOMString): TDOMText;
  2099. begin
  2100. TDOMNode(Result) := Alloc(TDOMText);
  2101. Result.Create(Self);
  2102. Result.FNodeValue := data;
  2103. end;
  2104. function TDOMDocument.CreateTextNodeBuf(Buf: DOMPChar; Length: Integer; IgnWS: Boolean): TDOMText;
  2105. begin
  2106. TDOMNode(Result) := Alloc(TDOMText);
  2107. Result.Create(Self);
  2108. SetString(Result.FNodeValue, Buf, Length);
  2109. if IgnWS then
  2110. Include(Result.FFlags, nfIgnorableWS);
  2111. end;
  2112. function TDOMDocument.CreateComment(const data: DOMString): TDOMComment;
  2113. begin
  2114. TDOMNode(Result) := Alloc(TDOMComment);
  2115. Result.Create(Self);
  2116. Result.FNodeValue := data;
  2117. end;
  2118. function TDOMDocument.CreateCommentBuf(Buf: DOMPChar; Length: Integer): TDOMComment;
  2119. begin
  2120. TDOMNode(Result) := Alloc(TDOMComment);
  2121. Result.Create(Self);
  2122. SetString(Result.FNodeValue, Buf, Length);
  2123. end;
  2124. function TDOMDocument.CreateCDATASection(const data: DOMString):
  2125. TDOMCDATASection;
  2126. begin
  2127. raise EDOMNotSupported.Create('DOMDocument.CreateCDATASection');
  2128. Result:=nil;
  2129. end;
  2130. function TDOMDocument.CreateProcessingInstruction(const target,
  2131. data: DOMString): TDOMProcessingInstruction;
  2132. begin
  2133. raise EDOMNotSupported.Create('DOMDocument.CreateProcessingInstruction');
  2134. Result:=nil;
  2135. end;
  2136. function TDOMDocument.CreateAttribute(const name: DOMString): TDOMAttr;
  2137. begin
  2138. if not IsXmlName(name) then
  2139. raise EDOMError.Create(INVALID_CHARACTER_ERR, 'DOMDocument.CreateAttribute');
  2140. TDOMNode(Result) := Alloc(TDOMAttr);
  2141. Result.Create(Self);
  2142. Result.FNSI.QName := FNames.FindOrAdd(DOMPChar(name), Length(name));
  2143. Include(Result.FFlags, nfSpecified);
  2144. end;
  2145. function TDOMDocument.CreateAttributeBuf(Buf: DOMPChar; Length: Integer): TDOMAttr;
  2146. begin
  2147. TDOMNode(Result) := Alloc(TDOMAttr);
  2148. Result.Create(Self);
  2149. Result.FNSI.QName := FNames.FindOrAdd(buf, Length);
  2150. Include(Result.FFlags, nfSpecified);
  2151. end;
  2152. function TDOMDocument.CreateEntityReference(const name: DOMString):
  2153. TDOMEntityReference;
  2154. begin
  2155. raise EDOMNotSupported.Create('DOMDocument.CreateEntityReference');
  2156. Result:=nil;
  2157. end;
  2158. function TDOMDocument.GetChildNodeList(aNode: TDOMNode): TDOMNodeList;
  2159. begin
  2160. if not (aNode is TDOMNode_WithChildren) then
  2161. aNode := FEmptyNode;
  2162. Result := TDOMNode_WithChildren(aNode).FChildNodes;
  2163. if Result = nil then
  2164. begin
  2165. Result := TDOMNodeList.Create(aNode);
  2166. TDOMNode_WithChildren(aNode).FChildNodes := Result;
  2167. end;
  2168. end;
  2169. function TDOMDocument.GetElementList(aNode: TDOMNode; const nsURI, aLocalName: DOMString;
  2170. UseNS: Boolean): TDOMNodeList;
  2171. var
  2172. L: Integer;
  2173. Key, P: DOMPChar;
  2174. Item: PHashItem;
  2175. begin
  2176. if FNodeLists = nil then
  2177. FNodeLists := THashTable.Create(32, True);
  2178. L := (sizeof(Pointer) div sizeof(WideChar)) + Length(aLocalName);
  2179. if UseNS then
  2180. Inc(L, Length(nsURI)+1);
  2181. GetMem(Key, L*sizeof(WideChar));
  2182. try
  2183. // compose the key for hashing
  2184. P := Key;
  2185. PPointer(P)^ := aNode;
  2186. Inc(PPointer(P));
  2187. Move(DOMPChar(aLocalName)^, P^, Length(aLocalName)*sizeof(WideChar));
  2188. if UseNS then
  2189. begin
  2190. Inc(P, Length(aLocalName));
  2191. P^ := #12; Inc(P); // separator -- diff ('foo','bar') from 'foobar'
  2192. Move(DOMPChar(nsURI)^, P^, Length(nsURI)*sizeof(WideChar));
  2193. end;
  2194. // try finding in the hashtable
  2195. Item := FNodeLists.FindOrAdd(Key, L);
  2196. Result := TDOMNodeList(Item^.Data);
  2197. if Result = nil then
  2198. begin
  2199. if UseNS then
  2200. Result := TDOMElementList.Create(aNode, nsURI, aLocalName)
  2201. else
  2202. Result := TDOMElementList.Create(aNode, aLocalName);
  2203. Item^.Data := Result;
  2204. end;
  2205. finally
  2206. FreeMem(Key);
  2207. end;
  2208. end;
  2209. function TDOMDocument.GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
  2210. begin
  2211. Result := GetElementList(Self, '', tagname, False);
  2212. end;
  2213. function TDOMDocument.GetElementsByTagNameNS(const nsURI, aLocalName: DOMString): TDOMNodeList;
  2214. begin
  2215. Result := GetElementList(Self, nsURI, aLocalName, True);
  2216. end;
  2217. { This is linear hence slow. However:
  2218. - if user code frees each nodelist ASAP, there are only few items in the hashtable
  2219. - if user code does not free nodelists, this is not called at all.
  2220. }
  2221. procedure TDOMDocument.NodeListDestroyed(aList: TDOMNodeList);
  2222. begin
  2223. if (not (nfDestroying in FFlags)) and (FNodeLists <> nil) then
  2224. FNodeLists.RemoveData(aList);
  2225. end;
  2226. function TDOMDocument.CreateAttributeNS(const nsURI,
  2227. QualifiedName: DOMString): TDOMAttr;
  2228. var
  2229. idx, PrefIdx: Integer;
  2230. begin
  2231. idx := IndexOfNS(nsURI, True);
  2232. PrefIdx := CheckQName(QualifiedName, idx);
  2233. if PrefIdx < 0 then
  2234. raise EDOMError.Create(-PrefIdx, 'Document.CreateAttributeNS');
  2235. TDOMNode(Result) := Alloc(TDOMAttr);
  2236. Result.Create(Self);
  2237. Result.FNSI.QName := FNames.FindOrAdd(DOMPChar(QualifiedName), Length(QualifiedName));
  2238. Result.FNSI.NSIndex := Word(idx);
  2239. Result.FNSI.PrefixLen := Word(PrefIdx);
  2240. Include(Result.FFlags, nfLevel2);
  2241. Include(Result.FFlags, nfSpecified);
  2242. end;
  2243. function TDOMDocument.CreateElementNS(const nsURI,
  2244. QualifiedName: DOMString): TDOMElement;
  2245. var
  2246. idx, PrefIdx: Integer;
  2247. begin
  2248. idx := IndexOfNS(nsURI, True);
  2249. PrefIdx := CheckQName(QualifiedName, idx);
  2250. if PrefIdx < 0 then
  2251. raise EDOMError.Create(-PrefIdx, 'Document.CreateElementNS');
  2252. TDOMNode(Result) := Alloc(TDOMElement);
  2253. Result.Create(Self);
  2254. Result.FNSI.QName := FNames.FindOrAdd(DOMPChar(QualifiedName), Length(QualifiedName));
  2255. Result.FNSI.NSIndex := Word(idx);
  2256. Result.FNSI.PrefixLen := Word(PrefIdx);
  2257. Include(Result.FFlags, nfLevel2);
  2258. Result.AttachDefaultAttrs;
  2259. end;
  2260. function TDOMDocument.GetElementById(const ElementID: DOMString): TDOMElement;
  2261. begin
  2262. Result := nil;
  2263. if Assigned(FIDList) then
  2264. Result := TDOMElement(FIDList.Get(DOMPChar(ElementID), Length(ElementID)));
  2265. end;
  2266. function TDOMDocument.ImportNode(ImportedNode: TDOMNode;
  2267. Deep: Boolean): TDOMNode;
  2268. begin
  2269. Result := ImportedNode.CloneNode(Deep, Self);
  2270. end;
  2271. function TDOMDocument.IndexOfNS(const nsURI: DOMString; AddIfAbsent: Boolean): Integer;
  2272. var
  2273. I: Integer;
  2274. begin
  2275. // TODO: elaborate implementation
  2276. for I := 0 to Length(FNamespaces)-1 do
  2277. if FNamespaces[I] = nsURI then
  2278. begin
  2279. Result := I;
  2280. Exit;
  2281. end;
  2282. if AddIfAbsent then
  2283. begin
  2284. Result := Length(FNamespaces);
  2285. SetLength(FNamespaces, Result+1);
  2286. FNamespaces[Result] := nsURI;
  2287. end
  2288. else
  2289. Result := -1;
  2290. end;
  2291. procedure TDOMDocument.SetXMLVersion(const aValue: DOMString);
  2292. begin
  2293. raise EDOMNotSupported.Create('DOMDocument.SetXMLVersion');
  2294. end;
  2295. procedure TDOMDocument.SetXMLStandalone(aValue: Boolean);
  2296. begin
  2297. raise EDOMNotSupported.Create('DOMDocument.SetXMLStandalone');
  2298. end;
  2299. constructor TXMLDocument.Create;
  2300. begin
  2301. inherited Create;
  2302. FXMLVersion := xmlVersion10;
  2303. end;
  2304. function TXMLDocument.CreateCDATASection(const data: DOMString):
  2305. TDOMCDATASection;
  2306. begin
  2307. TDOMNode(Result) := Alloc(TDOMCDATASection);
  2308. Result.Create(Self);
  2309. Result.FNodeValue := data;
  2310. end;
  2311. function TXMLDocument.CreateProcessingInstruction(const target,
  2312. data: DOMString): TDOMProcessingInstruction;
  2313. begin
  2314. if not IsXmlName(target) then
  2315. raise EDOMError.Create(INVALID_CHARACTER_ERR, 'XMLDocument.CreateProcessingInstruction');
  2316. TDOMNode(Result) := Alloc(TDOMProcessingInstruction);
  2317. Result.Create(Self);
  2318. Result.FTarget := target;
  2319. Result.FNodeValue := data;
  2320. end;
  2321. function TXMLDocument.CreateEntityReference(const name: DOMString):
  2322. TDOMEntityReference;
  2323. var
  2324. dType: TDOMDocumentType;
  2325. ent: TDOMEntity;
  2326. begin
  2327. if not IsXmlName(name) then
  2328. raise EDOMError.Create(INVALID_CHARACTER_ERR, 'XMLDocument.CreateEntityReference');
  2329. TDOMNode(Result) := Alloc(TDOMEntityReference);
  2330. Result.Create(Self);
  2331. Result.FName := name;
  2332. dType := DocType;
  2333. if Assigned(dType) then
  2334. begin
  2335. TDOMNode(ent) := dType.Entities.GetNamedItem(name);
  2336. if Assigned(ent) then
  2337. ent.CloneChildren(Result, Self);
  2338. end;
  2339. Result.SetReadOnly(True);
  2340. end;
  2341. procedure TXMLDocument.SetXMLVersion(const aValue: DOMString);
  2342. begin
  2343. if aValue = '1.0' then
  2344. FXMLVersion := xmlVersion10
  2345. else if aValue = '1.1' then
  2346. FXMLVersion := xmlVersion11
  2347. else
  2348. raise EDOMNotSupported.Create('XMLDocument.SetXMLVersion');
  2349. end;
  2350. procedure TXMLDocument.SetXMLStandalone(aValue: Boolean);
  2351. begin
  2352. FXmlStandalone := aValue;
  2353. end;
  2354. { TDOMNode_NS }
  2355. function TDOMNode_NS.GetNodeName: DOMString;
  2356. begin
  2357. // Because FNSI.QName is not set by the TDOMNode itself, but is set by
  2358. // other classes/functions, it is necessary to check if FNSQ.QName is
  2359. // assigned.
  2360. if assigned(FNSI.QName) then
  2361. Result := FNSI.QName^.Key
  2362. else
  2363. Result := '';
  2364. end;
  2365. function TDOMNode_NS.GetLocalName: DOMString;
  2366. begin
  2367. if nfLevel2 in FFlags then
  2368. Result := Copy(FNSI.QName^.Key, FNSI.PrefixLen+1, MaxInt)
  2369. else
  2370. Result := '';
  2371. end;
  2372. function TDOMNode_NS.GetNamespaceURI: DOMString;
  2373. begin
  2374. Result := FOwnerDocument.FNamespaces[FNSI.NSIndex];
  2375. end;
  2376. function TDOMNode_NS.GetPrefix: DOMString;
  2377. begin
  2378. if FNSI.PrefixLen < 2 then
  2379. Result := ''
  2380. else
  2381. Result := Copy(FNSI.QName^.Key, 1, FNSI.PrefixLen-1);
  2382. end;
  2383. procedure TDOMNode_NS.SetPrefix(const Value: DOMString);
  2384. var
  2385. NewName: DOMString;
  2386. begin
  2387. Changing;
  2388. if not IsXmlName(Value) then
  2389. raise EDOMError.Create(INVALID_CHARACTER_ERR, 'Node.SetPrefix');
  2390. if (Pos(WideChar(':'), Value) > 0) or not (nfLevel2 in FFlags) or
  2391. ((Value = 'xml') and (FNSI.NSIndex <> 1)) or
  2392. ((ClassType = TDOMAttr) and // BAD!
  2393. ((Value = 'xmlns') and (FNSI.NSIndex <> 2)) or (FNSI.QName^.Key = 'xmlns')) then
  2394. raise EDOMNamespace.Create('Node.SetPrefix');
  2395. // TODO: rehash properly
  2396. NewName := Value + ':' + Copy(FNSI.QName^.Key, FNSI.PrefixLen+1, MaxInt);
  2397. FNSI.QName := FOwnerDocument.FNames.FindOrAdd(DOMPChar(NewName), Length(NewName));
  2398. FNSI.PrefixLen := Length(Value)+1;
  2399. end;
  2400. function TDOMNode_NS.CompareName(const AName: DOMString): Integer;
  2401. begin
  2402. Result := CompareDOMStrings(DOMPChar(AName), DOMPChar(NodeName), Length(AName), Length(NodeName));
  2403. end;
  2404. procedure TDOMNode_NS.SetNSI(const nsUri: DOMString; ColonPos: Integer);
  2405. begin
  2406. FNSI.NSIndex := FOwnerDocument.IndexOfNS(nsURI, True);
  2407. FNSI.PrefixLen := ColonPos;
  2408. Include(FFlags, nfLevel2);
  2409. end;
  2410. // -------------------------------------------------------
  2411. // Attr
  2412. // -------------------------------------------------------
  2413. function TDOMAttr.GetNodeType: Integer;
  2414. begin
  2415. Result := ATTRIBUTE_NODE;
  2416. end;
  2417. function TDOMAttr.GetParentNode: TDOMNode;
  2418. begin
  2419. Result := nil;
  2420. end;
  2421. destructor TDOMAttr.Destroy;
  2422. begin
  2423. if Assigned(FParentNode) and not (nfDestroying in FParentNode.FFlags) then
  2424. // TODO: This may raise NOT_FOUND_ERR in case something's really wrong
  2425. TDOMElement(FParentNode).RemoveAttributeNode(Self);
  2426. FParentNode := nil;
  2427. inherited Destroy;
  2428. end;
  2429. function TDOMAttr.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
  2430. begin
  2431. // Cloned attribute is always specified and carries its children
  2432. if nfLevel2 in FFlags then
  2433. Result := ACloneOwner.CreateAttributeNS(namespaceURI, NodeName)
  2434. else
  2435. Result := ACloneOwner.CreateAttribute(NodeName);
  2436. TDOMAttr(Result).FDataType := FDataType;
  2437. CloneChildren(Result, ACloneOwner);
  2438. end;
  2439. function TDOMAttr.GetNodeValue: DOMString;
  2440. begin
  2441. Result := GetTextContent;
  2442. if FDataType <> dtCdata then
  2443. NormalizeSpaces(Result);
  2444. end;
  2445. procedure TDOMAttr.SetNodeValue(const AValue: DOMString);
  2446. begin
  2447. SetTextContent(AValue);
  2448. Include(FFlags, nfSpecified);
  2449. end;
  2450. function TDOMAttr.GetSpecified: Boolean;
  2451. begin
  2452. Result := nfSpecified in FFlags;
  2453. end;
  2454. function TDOMAttr.GetIsID: Boolean;
  2455. begin
  2456. Result := FDataType = dtID;
  2457. end;
  2458. function TDOMAttr.GetOwnerElement: TDOMElement;
  2459. begin
  2460. Result := TDOMElement(FParentNode);
  2461. end;
  2462. // -------------------------------------------------------
  2463. // Element
  2464. // -------------------------------------------------------
  2465. function TDOMElement.GetNodeType: Integer;
  2466. begin
  2467. Result := ELEMENT_NODE;
  2468. end;
  2469. destructor TDOMElement.Destroy;
  2470. begin
  2471. Include(FFlags, nfDestroying);
  2472. if Assigned(FOwnerDocument.FIDList) then
  2473. FOwnerDocument.RemoveID(Self);
  2474. FAttributes.Free;
  2475. FAttributes := nil;
  2476. inherited Destroy;
  2477. end;
  2478. function TDOMElement.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
  2479. var
  2480. i: Integer;
  2481. Attr, AttrClone: TDOMAttr;
  2482. begin
  2483. if ACloneOwner <> FOwnerDocument then
  2484. begin
  2485. // Importing has to go the hard way...
  2486. if nfLevel2 in FFlags then
  2487. Result := ACloneOwner.CreateElementNS(NamespaceURI, NodeName)
  2488. else
  2489. Result := ACloneOwner.CreateElement(NodeName);
  2490. if Assigned(FAttributes) then
  2491. begin
  2492. for i := 0 to FAttributes.Length - 1 do
  2493. begin
  2494. Attr := TDOMAttr(FAttributes[i]);
  2495. // destroy defaulted attributes (if any), it is safe because caller had not seen them yet
  2496. if Attr.Specified then
  2497. TDOMElement(Result).SetAttributeNode(TDOMAttr(Attr.CloneNode(True, ACloneOwner))).Free;
  2498. end;
  2499. end;
  2500. end
  2501. else // Cloning may cheat a little bit.
  2502. begin
  2503. Result := FOwnerDocument.Alloc(TDOMElement);
  2504. TDOMElement(Result).Create(FOwnerDocument);
  2505. TDOMElement(Result).FNSI := FNSI;
  2506. if nfLevel2 in FFlags then
  2507. Include(Result.FFlags, nfLevel2);
  2508. if Assigned(FAttributes) then
  2509. begin
  2510. // clone all attributes, but preserve nfSpecified flag
  2511. for i := 0 to FAttributes.Length - 1 do
  2512. begin
  2513. Attr := TDOMAttr(FAttributes[i]);
  2514. AttrClone := TDOMAttr(Attr.CloneNode(True, ACloneOwner));
  2515. if not Attr.Specified then
  2516. Exclude(AttrClone.FFlags, nfSpecified);
  2517. TDOMElement(Result).SetAttributeNode(AttrClone);
  2518. end;
  2519. end;
  2520. end;
  2521. if deep then
  2522. CloneChildren(Result, ACloneOwner);
  2523. end;
  2524. procedure TDOMElement.AttachDefaultAttrs;
  2525. var
  2526. eldef: TElementDecl;
  2527. attrdef: TAttributeDef;
  2528. I: Integer;
  2529. begin
  2530. if not Assigned(FNSI.QName) then // safeguard
  2531. Exit;
  2532. eldef := TElementDecl(FNSI.QName^.Data);
  2533. if Assigned(eldef) and eldef.NeedsDefaultPass then
  2534. begin
  2535. for I := 0 to eldef.AttrDefCount-1 do
  2536. begin
  2537. attrdef := eldef.AttrDefs[I];
  2538. if attrdef.Default in [adDefault, adFixed] then
  2539. RestoreDefaultAttr(attrdef);
  2540. end;
  2541. end;
  2542. end;
  2543. function TDOMElement.InternalLookupPrefix(const nsURI: DOMString; Original: TDOMElement): DOMString;
  2544. var
  2545. I: Integer;
  2546. Attr: TDOMAttr;
  2547. begin
  2548. result := '';
  2549. if Self = nil then
  2550. Exit;
  2551. if (nfLevel2 in FFlags) and (namespaceURI = nsURI) and (FNSI.PrefixLen > 0) then
  2552. begin
  2553. Result := Prefix;
  2554. if Original.LookupNamespaceURI(result) = nsURI then
  2555. Exit;
  2556. end;
  2557. if Assigned(FAttributes) then
  2558. begin
  2559. for I := 0 to FAttributes.Length-1 do
  2560. begin
  2561. Attr := TDOMAttr(FAttributes[I]);
  2562. if (Attr.Prefix = 'xmlns') and (Attr.Value = nsURI) then
  2563. begin
  2564. result := Attr.LocalName;
  2565. if Original.LookupNamespaceURI(result) = nsURI then
  2566. Exit;
  2567. end;
  2568. end;
  2569. end;
  2570. result := GetAncestorElement(Self).InternalLookupPrefix(nsURI, Original);
  2571. end;
  2572. function LoadAttribute(doc: TDOMDocument; src: PNodeData): TDOMAttr;
  2573. var
  2574. curr: PNodeData;
  2575. begin
  2576. TDOMNode(result) := doc.Alloc(TDOMAttr);
  2577. result.Create(doc);
  2578. result.FNSI.QName := src^.FQName;
  2579. if not src^.FIsDefault then
  2580. Include(result.FFlags, nfSpecified);
  2581. if Assigned(src^.FTypeInfo) then
  2582. result.FDataType := TAttributeDef(src^.FTypeInfo).DataType;
  2583. if Assigned(src^.FNsUri) then
  2584. result.SetNSI(src^.FNsUri^.Key, src^.FColonPos+1);
  2585. if Assigned(src^.FNext) then
  2586. begin
  2587. curr := src^.FNext;
  2588. while Assigned(curr) do
  2589. begin
  2590. case curr^.FNodeType of
  2591. ntText: result.InternalAppend(doc.CreateTextNode(curr^.FValueStr));
  2592. ntEntityReference: result.InternalAppend(doc.CreateEntityReference(curr^.FQName^.Key));
  2593. end;
  2594. curr := curr^.FNext;
  2595. end;
  2596. end
  2597. else if src^.FValueStr <> '' then
  2598. result.InternalAppend(doc.CreateTextNode(src^.FValueStr));
  2599. end;
  2600. function LoadElement(doc: TDOMDocument; src: PNodeData; attrCount: Integer): TDOMElement;
  2601. var
  2602. i: Integer;
  2603. begin
  2604. TDOMNode(result) := doc.Alloc(TDOMElement);
  2605. result.Create(doc);
  2606. result.FNSI.QName := src^.FQName;
  2607. if Assigned(src^.FNsUri) then
  2608. result.SetNSI(src^.FNsUri^.Key, src^.FColonPos+1);
  2609. for i := 0 to attrCount-1 do
  2610. begin
  2611. Inc(src);
  2612. result.SetAttributeNode(LoadAttribute(doc, src));
  2613. // Attach element to ID map entry if necessary
  2614. if Assigned(src^.FIDEntry) then
  2615. src^.FIDEntry^.Data := Result;
  2616. end;
  2617. end;
  2618. procedure TDOMElement.RestoreDefaultAttr(AttrDef: TAttributeDef);
  2619. var
  2620. Attr: TDOMAttr;
  2621. ColonPos: Integer;
  2622. AttrName, nsuri: DOMString;
  2623. begin
  2624. if nfDestroying in FOwnerDocument.FFlags then
  2625. Exit;
  2626. Attr := LoadAttribute(FOwnerDocument, AttrDef.Data);
  2627. AttrName := Attr.Name;
  2628. ColonPos := Pos(WideChar(':'), AttrName);
  2629. if Pos(DOMString('xmlns'), AttrName) = 1 then
  2630. begin
  2631. if (Length(AttrName) = 5) or (ColonPos = 6) then
  2632. Attr.SetNSI(stduri_xmlns, ColonPos);
  2633. end
  2634. else if ColonPos > 0 then
  2635. begin
  2636. if (ColonPos = 4) and (Pos(DOMString('xml'), AttrName) = 1) then
  2637. Attr.SetNSI(stduri_xml, 4)
  2638. else
  2639. begin
  2640. nsuri := LookupNamespaceURI(Copy(AttrName, 1, ColonPos-1));
  2641. // TODO: what if prefix isn't defined?
  2642. Attr.SetNSI(nsuri, ColonPos);
  2643. end
  2644. end;
  2645. // TODO: this is cheat, should look at config['namespaces'] instead.
  2646. // revisit when it is implemented.
  2647. if nfLevel2 in FFlags then
  2648. Include(Attr.FFlags, nfLevel2);
  2649. // There should be no matching attribute at this point, so non-namespace method is ok
  2650. SetAttributeNode(Attr);
  2651. end;
  2652. procedure TDOMElement.Normalize;
  2653. var
  2654. I: Integer;
  2655. begin
  2656. if Assigned(FAttributes) then
  2657. for I := 0 to FAttributes.Length - 1 do
  2658. FAttributes[I].Normalize;
  2659. inherited Normalize;
  2660. end;
  2661. function TDOMElement.GetAttributes: TDOMNamedNodeMap;
  2662. begin
  2663. if FAttributes=nil then
  2664. FAttributes := TAttributeMap.Create(Self);
  2665. Result := FAttributes;
  2666. end;
  2667. function TDOMElement.GetAttribute(const name: DOMString): DOMString;
  2668. var
  2669. Attr: TDOMNode;
  2670. begin
  2671. SetLength(Result, 0);
  2672. if Assigned(FAttributes) then
  2673. begin
  2674. Attr := FAttributes.GetNamedItem(name);
  2675. if Assigned(Attr) then
  2676. Result := Attr.NodeValue;
  2677. end;
  2678. end;
  2679. function TDOMElement.GetAttributeNS(const nsURI, aLocalName: DOMString): DOMString;
  2680. var
  2681. Attr: TDOMNode;
  2682. begin
  2683. SetLength(Result, 0);
  2684. if Assigned(FAttributes) then
  2685. begin
  2686. Attr := FAttributes.GetNamedItemNS(nsURI, aLocalName);
  2687. if Assigned(Attr) then
  2688. Result := Attr.NodeValue;
  2689. end;
  2690. end;
  2691. procedure TDOMElement.SetAttribute(const name, value: DOMString);
  2692. var
  2693. I: Cardinal;
  2694. attr: TDOMAttr;
  2695. begin
  2696. Changing;
  2697. if Attributes.Find(name, I) then
  2698. Attr := FAttributes[I] as TDOMAttr
  2699. else
  2700. begin
  2701. Attr := FOwnerDocument.CreateAttribute(name);
  2702. Attr.FParentNode := Self;
  2703. FAttributes.FList.Insert(I, Attr);
  2704. end;
  2705. attr.NodeValue := value;
  2706. end;
  2707. procedure TDOMElement.RemoveAttribute(const name: DOMString);
  2708. begin
  2709. Changing;
  2710. // (note) NamedNodeMap.RemoveNamedItem can raise NOT_FOUND_ERR and we should not.
  2711. if Assigned(FAttributes) then
  2712. FAttributes.InternalRemove(name).Free;
  2713. end;
  2714. procedure TDOMElement.RemoveAttributeNS(const nsURI,
  2715. aLocalName: DOMString);
  2716. begin
  2717. Changing;
  2718. if Assigned(FAttributes) then
  2719. TAttributeMap(FAttributes).InternalRemoveNS(nsURI, aLocalName).Free;
  2720. end;
  2721. procedure TDOMElement.SetAttributeNS(const nsURI, qualifiedName,
  2722. value: DOMString);
  2723. var
  2724. I: Cardinal;
  2725. Attr: TDOMAttr;
  2726. idx, prefIdx: Integer;
  2727. begin
  2728. Changing;
  2729. idx := FOwnerDocument.IndexOfNS(nsURI, True);
  2730. prefIdx := CheckQName(qualifiedName, idx);
  2731. if prefIdx < 0 then
  2732. raise EDOMError.Create(-prefIdx, 'Element.SetAttributeNS');
  2733. if TAttributeMap(Attributes).FindNS(idx, Copy(qualifiedName, prefIdx+1, MaxInt), I) then
  2734. begin
  2735. Attr := TDOMAttr(FAttributes[I]);
  2736. // need to reinsert because the nodeName may change
  2737. FAttributes.FList.Delete(I);
  2738. end
  2739. else
  2740. begin
  2741. TDOMNode(Attr) := FOwnerDocument.Alloc(TDOMAttr);
  2742. Attr.Create(FOwnerDocument);
  2743. Attr.FParentNode := Self;
  2744. Attr.FNSI.NSIndex := Word(idx);
  2745. Include(Attr.FFlags, nfLevel2);
  2746. end;
  2747. // keep list sorted by DOM Level 1 name
  2748. FAttributes.Find(qualifiedName, I);
  2749. FAttributes.FList.Insert(I, Attr);
  2750. // TODO: rehash properly, same issue as with Node.SetPrefix()
  2751. Attr.FNSI.QName := FOwnerDocument.FNames.FindOrAdd(DOMPChar(qualifiedName), Length(qualifiedName));
  2752. Attr.FNSI.PrefixLen := Word(prefIdx);
  2753. attr.NodeValue := value;
  2754. end;
  2755. function TDOMElement.GetAttributeNode(const name: DOMString): TDOMAttr;
  2756. begin
  2757. if Assigned(FAttributes) then
  2758. Result := FAttributes.GetNamedItem(name) as TDOMAttr
  2759. else
  2760. Result := nil;
  2761. end;
  2762. function TDOMElement.GetAttributeNodeNS(const nsURI, aLocalName: DOMString): TDOMAttr;
  2763. begin
  2764. if Assigned(FAttributes) then
  2765. Result := FAttributes.GetNamedItemNS(nsURI, aLocalName) as TDOMAttr
  2766. else
  2767. Result := nil;
  2768. end;
  2769. function TDOMElement.SetAttributeNode(NewAttr: TDOMAttr): TDOMAttr;
  2770. begin
  2771. Result := Attributes.SetNamedItem(NewAttr) as TDOMAttr;
  2772. end;
  2773. function TDOMElement.SetAttributeNodeNS(NewAttr: TDOMAttr): TDOMAttr;
  2774. begin
  2775. Result := Attributes.SetNamedItemNS(NewAttr) as TDOMAttr;
  2776. end;
  2777. function TDOMElement.RemoveAttributeNode(OldAttr: TDOMAttr): TDOMAttr;
  2778. var
  2779. Index: Integer;
  2780. begin
  2781. Changing;
  2782. Result := OldAttr;
  2783. if Assigned(FAttributes) then
  2784. begin
  2785. Index := FAttributes.FList.IndexOf(OldAttr);
  2786. if Index > -1 then
  2787. begin
  2788. FAttributes.Delete(Index);
  2789. Exit;
  2790. end;
  2791. end;
  2792. raise EDOMNotFound.Create('Element.RemoveAttributeNode');
  2793. end;
  2794. function TDOMElement.GetElementsByTagName(const name: DOMString): TDOMNodeList;
  2795. begin
  2796. Result := FOwnerDocument.GetElementList(Self, '', name, False);
  2797. end;
  2798. function TDOMElement.GetElementsByTagNameNS(const nsURI, aLocalName: DOMString): TDOMNodeList;
  2799. begin
  2800. Result := FOwnerDocument.GetElementList(Self, nsURI, aLocalName, True);
  2801. end;
  2802. function TDOMElement.hasAttribute(const name: DOMString): Boolean;
  2803. begin
  2804. Result := Assigned(FAttributes) and
  2805. Assigned(FAttributes.GetNamedItem(name));
  2806. end;
  2807. function TDOMElement.hasAttributeNS(const nsURI, aLocalName: DOMString): Boolean;
  2808. begin
  2809. Result := Assigned(FAttributes) and
  2810. Assigned(FAttributes.getNamedItemNS(nsURI, aLocalName));
  2811. end;
  2812. function TDOMElement.HasAttributes: Boolean;
  2813. begin
  2814. Result := Assigned(FAttributes) and (FAttributes.Length > 0);
  2815. end;
  2816. // -------------------------------------------------------
  2817. // Text
  2818. // -------------------------------------------------------
  2819. function TDOMText.GetNodeType: Integer;
  2820. begin
  2821. Result := TEXT_NODE;
  2822. end;
  2823. function TDOMText.GetNodeName: DOMString;
  2824. begin
  2825. Result := '#text';
  2826. end;
  2827. procedure TDOMText.SetNodeValue(const aValue: DOMString);
  2828. begin
  2829. inherited SetNodeValue(aValue);
  2830. // TODO: may analyze aValue, but this will slow things down...
  2831. Exclude(FFlags, nfIgnorableWS);
  2832. end;
  2833. function TDOMText.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
  2834. begin
  2835. Result := ACloneOwner.CreateTextNode(FNodeValue);
  2836. end;
  2837. function TDOMText.SplitText(offset: LongWord): TDOMText;
  2838. var
  2839. L: LongWord;
  2840. begin
  2841. Changing;
  2842. L := Length;
  2843. if offset > L then
  2844. raise EDOMIndexSize.Create('Text.SplitText');
  2845. Result := FOwnerDocument.CreateTextNodeBuf(@FNodeValue[offset+1], L-offset, False);
  2846. Result.FFlags := FFlags * [nfIgnorableWS];
  2847. FNodeValue := Copy(FNodeValue, 1, offset);
  2848. if Assigned(FParentNode) then
  2849. FParentNode.InsertBefore(Result, FNextSibling);
  2850. end;
  2851. function TDOMText.IsElementContentWhitespace: Boolean;
  2852. begin
  2853. Result := nfIgnorableWS in FFlags;
  2854. end;
  2855. // -------------------------------------------------------
  2856. // Comment
  2857. // -------------------------------------------------------
  2858. function TDOMComment.GetNodeType: Integer;
  2859. begin
  2860. Result := COMMENT_NODE;
  2861. end;
  2862. function TDOMComment.GetNodeName: DOMString;
  2863. begin
  2864. Result := '#comment';
  2865. end;
  2866. function TDOMComment.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
  2867. begin
  2868. Result := ACloneOwner.CreateComment(FNodeValue);
  2869. end;
  2870. // -------------------------------------------------------
  2871. // CDATASection
  2872. // -------------------------------------------------------
  2873. function TDOMCDATASection.GetNodeType: Integer;
  2874. begin
  2875. Result := CDATA_SECTION_NODE;
  2876. end;
  2877. function TDOMCDATASection.GetNodeName: DOMString;
  2878. begin
  2879. Result := '#cdata-section';
  2880. end;
  2881. function TDOMCDATASection.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
  2882. begin
  2883. Result := ACloneOwner.CreateCDATASection(FNodeValue);
  2884. end;
  2885. // -------------------------------------------------------
  2886. // DocumentType
  2887. // -------------------------------------------------------
  2888. function TDOMDocumentType.GetNodeType: Integer;
  2889. begin
  2890. Result := DOCUMENT_TYPE_NODE;
  2891. end;
  2892. function TDOMDocumentType.GetNodeName: DOMString;
  2893. begin
  2894. Result := FModel.FName;
  2895. end;
  2896. function TDOMDocumentType.GetPublicID: DOMString;
  2897. begin
  2898. Result := FModel.FPublicID;
  2899. end;
  2900. function TDOMDocumentType.GetSystemID: DOMString;
  2901. begin
  2902. Result := FModel.FSystemID;
  2903. end;
  2904. function TDOMDocumentType.GetInternalSubset: DOMString;
  2905. begin
  2906. Result := FModel.FInternalSubset;
  2907. end;
  2908. function ConvertEntity(Entry: PHashItem; arg: Pointer): Boolean;
  2909. var
  2910. this: TDOMDocumentType absolute arg;
  2911. node: TDOMEntity;
  2912. begin
  2913. node := TDOMEntity.Create(this.ownerDocument);
  2914. node.FDecl := TEntityDecl(Entry^.Data);
  2915. node.FBaseURI := node.FDecl.FURI;
  2916. node.SetReadOnly(True);
  2917. this.Entities.SetNamedItem(node);
  2918. Result := True;
  2919. end;
  2920. function ConvertNotation(Entry: PHashItem; arg: Pointer): Boolean;
  2921. var
  2922. this: TDOMDocumentType absolute arg;
  2923. node: TDOMNotation;
  2924. begin
  2925. node := TDOMNotation.Create(this.ownerDocument);
  2926. node.FDecl := TNotationDecl(Entry^.Data);
  2927. node.FBaseURI := node.FDecl.FURI;
  2928. node.SetReadOnly(True);
  2929. this.Notations.SetNamedItem(node);
  2930. Result := True;
  2931. end;
  2932. constructor TDOMDocumentType.Create(aOwner: TDOMDocument; aModel: TDTDModel);
  2933. begin
  2934. inherited Create(aOwner);
  2935. FModel := aModel.Reference;
  2936. FModel.Entities.ForEach(@ConvertEntity, Self);
  2937. FModel.Notations.ForEach(@ConvertNotation, Self);
  2938. SetReadOnly(True);
  2939. end;
  2940. destructor TDOMDocumentType.Destroy;
  2941. begin
  2942. FModel.Release;
  2943. FEntities.Free;
  2944. FNotations.Free;
  2945. inherited Destroy;
  2946. end;
  2947. function TDOMDocumentType.GetEntities: TDOMNamedNodeMap;
  2948. begin
  2949. if FEntities = nil then
  2950. FEntities := TDOMNamedNodeMap.Create(Self);
  2951. Result := FEntities;
  2952. end;
  2953. function TDOMDocumentType.GetNotations: TDOMNamedNodeMap;
  2954. begin
  2955. if FNotations = nil then
  2956. FNotations := TDOMNamedNodeMap.Create(Self);
  2957. Result := FNotations;
  2958. end;
  2959. // -------------------------------------------------------
  2960. // Notation
  2961. // -------------------------------------------------------
  2962. function TDOMNotation.GetNodeType: Integer;
  2963. begin
  2964. Result := NOTATION_NODE;
  2965. end;
  2966. function TDOMNotation.GetNodeName: DOMString;
  2967. begin
  2968. Result := FDecl.FName;
  2969. end;
  2970. function TDOMNotation.GetPublicID: DOMString;
  2971. begin
  2972. Result := FDecl.FPublicID;
  2973. end;
  2974. function TDOMNotation.GetSystemID: DOMString;
  2975. begin
  2976. Result := FDecl.FSystemID;
  2977. end;
  2978. function TDOMNotation.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
  2979. begin
  2980. Result := ACloneOwner.Alloc(TDOMNotation);
  2981. TDOMNotation(Result).Create(ACloneOwner);
  2982. TDOMNotation(Result).FDecl := FDecl;
  2983. // notation cannot have children, ignore Deep
  2984. end;
  2985. // -------------------------------------------------------
  2986. // Entity
  2987. // -------------------------------------------------------
  2988. function TDOMEntity.GetNodeType: Integer;
  2989. begin
  2990. Result := ENTITY_NODE;
  2991. end;
  2992. function TDOMEntity.GetNodeName: DOMString;
  2993. begin
  2994. Result := FDecl.FName;
  2995. end;
  2996. function TDOMEntity.GetPublicID: DOMString;
  2997. begin
  2998. Result := FDecl.FPublicID;
  2999. end;
  3000. function TDOMEntity.GetSystemID: DOMString;
  3001. begin
  3002. Result := FDecl.FSystemID;
  3003. end;
  3004. function TDOMEntity.GetNotationName: DOMString;
  3005. begin
  3006. Result := FDecl.FNotationName;
  3007. end;
  3008. function TDOMEntity.CloneNode(deep: Boolean; aCloneOwner: TDOMDocument): TDOMNode;
  3009. begin
  3010. Result := aCloneOwner.Alloc(TDOMEntity);
  3011. TDOMEntity(Result).Create(aCloneOwner);
  3012. TDOMEntity(Result).FDecl := FDecl;
  3013. if deep then
  3014. CloneChildren(Result, aCloneOwner);
  3015. Result.SetReadOnly(True);
  3016. end;
  3017. // -------------------------------------------------------
  3018. // EntityReference
  3019. // -------------------------------------------------------
  3020. function TDOMEntityReference.GetNodeType: Integer;
  3021. begin
  3022. Result := ENTITY_REFERENCE_NODE;
  3023. end;
  3024. function TDOMEntityReference.GetNodeName: DOMString;
  3025. begin
  3026. Result := FName;
  3027. end;
  3028. function TDOMEntityReference.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
  3029. begin
  3030. Result := ACloneOwner.CreateEntityReference(FName);
  3031. end;
  3032. // -------------------------------------------------------
  3033. // ProcessingInstruction
  3034. // -------------------------------------------------------
  3035. function TDOMProcessingInstruction.CloneNode(deep: Boolean;
  3036. ACloneOwner: TDOMDocument): TDOMNode;
  3037. begin
  3038. Result := ACloneOwner.CreateProcessingInstruction(Target, Data);
  3039. end;
  3040. function TDOMProcessingInstruction.GetNodeType: Integer;
  3041. begin
  3042. Result := PROCESSING_INSTRUCTION_NODE;
  3043. end;
  3044. function TDOMProcessingInstruction.GetNodeName: DOMString;
  3045. begin
  3046. Result := FTarget;
  3047. end;
  3048. function TDOMProcessingInstruction.GetNodeValue: DOMString;
  3049. begin
  3050. Result := FNodeValue;
  3051. end;
  3052. procedure TDOMProcessingInstruction.SetNodeValue(const AValue: DOMString);
  3053. begin
  3054. Changing;
  3055. FNodeValue := AValue;
  3056. end;
  3057. { TNodePool }
  3058. constructor TNodePool.Create(AElementSize: Integer; AElementCount: Integer);
  3059. begin
  3060. FElementSize := AElementSize;
  3061. AddExtent(AElementCount);
  3062. end;
  3063. destructor TNodePool.Destroy;
  3064. var
  3065. ext, next: PExtent;
  3066. ptr, ptr_end: PAnsiChar;
  3067. sz: Integer;
  3068. begin
  3069. ext := FCurrExtent;
  3070. ptr := PAnsiChar(FCurrBlock) + FElementSize;
  3071. sz := FCurrExtentSize;
  3072. while Assigned(ext) do
  3073. begin
  3074. // call destructors for everyone still there
  3075. ptr_end := PAnsiChar(ext) + sizeof(TExtent) + (sz - 1) * FElementSize;
  3076. while ptr <= ptr_end do
  3077. begin
  3078. if TDOMNode(ptr).FPool = Self then
  3079. TObject(ptr).Destroy;
  3080. Inc(ptr, FElementSize);
  3081. end;
  3082. // dispose the extent and pass to the next one
  3083. next := ext^.Next;
  3084. FreeMem(ext);
  3085. ext := next;
  3086. sz := sz div 2;
  3087. ptr := PAnsiChar(ext) + sizeof(TExtent);
  3088. end;
  3089. inherited Destroy;
  3090. end;
  3091. procedure TNodePool.AddExtent(AElemCount: Integer);
  3092. var
  3093. ext: PExtent;
  3094. begin
  3095. Assert((FCurrExtent = nil) or
  3096. (PAnsiChar(FCurrBlock) < PAnsiChar(FCurrExtent) + sizeof(TExtent)));
  3097. Assert(AElemCount > 0);
  3098. GetMem(ext, sizeof(TExtent) + AElemCount * FElementSize);
  3099. ext^.Next := FCurrExtent;
  3100. // point to the beginning of the last block of extent
  3101. FCurrBlock := TDOMNode(PAnsiChar(ext) + sizeof(TExtent) + (AElemCount - 1) * FElementSize);
  3102. FCurrExtent := ext;
  3103. FCurrExtentSize := AElemCount;
  3104. end;
  3105. function TNodePool.AllocNode(AClass: TDOMNodeClass): TDOMNode;
  3106. begin
  3107. if Assigned(FFirstFree) then
  3108. begin
  3109. Result := FFirstFree; // remove from free list
  3110. FFirstFree := TDOMNode(Result.FPool);
  3111. end
  3112. else
  3113. begin
  3114. if PAnsiChar(FCurrBlock) < PAnsiChar(FCurrExtent) + sizeof(TExtent) then
  3115. AddExtent(FCurrExtentSize * 2);
  3116. Result := FCurrBlock;
  3117. Dec(PAnsiChar(FCurrBlock), FElementSize);
  3118. end;
  3119. AClass.InitInstance(Result);
  3120. Result.FPool := Self; // mark as used
  3121. end;
  3122. procedure TNodePool.FreeNode(ANode: TDOMNode);
  3123. begin
  3124. ANode.FPool := FFirstFree;
  3125. FFirstFree := ANode;
  3126. end;
  3127. end.