← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/lazutils/laz2_dom.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

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