Browse Source

* merged xml updates from lazarus

peter 21 years ago
parent
commit
ae161ab4b9
12 changed files with 3257 additions and 1597 deletions
  1. 1 1
      fcl/Makefile
  2. 1 1
      fcl/Makefile.fpc
  3. 1181 0
      fcl/inc/avl_tree.pp
  4. 233 131
      fcl/xml/dom.pp
  5. 289 286
      fcl/xml/dom_html.pp
  6. 229 226
      fcl/xml/htmldefs.pp
  7. 5 2
      fcl/xml/htmwrite.pp
  8. 195 192
      fcl/xml/sax_html.pp
  9. 166 61
      fcl/xml/xmlcfg.pp
  10. 418 176
      fcl/xml/xmlread.pp
  11. 167 149
      fcl/xml/xmlwrite.pp
  12. 372 372
      fcl/xml/xpath.pp

+ 1 - 1
fcl/Makefile

@@ -225,7 +225,7 @@ ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
 CLASSES10=classes
 endif
 override TARGET_DIRS+=xml image db shedit passrc net
-override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils
+override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls registry eventlog custapp cgiapp wformat whtml wtex rttiutils avl_tree
 ifeq ($(OS_TARGET),linux)
 override TARGET_UNITS+=process resolve ssockets fpasync syncobjs
 endif

+ 1 - 1
fcl/Makefile.fpc

@@ -23,7 +23,7 @@ units=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszl
 dirs=xml image db shedit passrc net
 units=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext \
       iostream zstream cachecls xmlreg registry eventlog custapp cgiapp \
-      wformat whtml wtex rttiutils
+      wformat whtml wtex rttiutils avl_tree
 units_freebsd=process ssockets resolve fpasync syncobjs
 units_darwin=process ssockets resolve fpasync syncobjs
 units_netbsd=process ssockets resolve fpasync

+ 1181 - 0
fcl/inc/avl_tree.pp

@@ -0,0 +1,1181 @@
+{
+ ***************************************************************************
+ *                                                                         *
+ *   This source is free software; you can redistribute it and/or modify   *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ *   This code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
+ *                                                                         *
+ ***************************************************************************
+
+  Author: Mattias Gaertner
+  
+  Abstract:
+    TAVLTree is an Average Level binary Tree. This binary tree is always
+    balanced, so that inserting, deleting and finding a node is performed in
+    O(log(#Nodes)).
+}
+unit AVL_Tree;
+
+{$ifdef FPC}{$mode objfpc}{$endif}{$H+}
+
+interface
+
+{off $DEFINE MEM_CHECK}
+
+uses
+  {$IFDEF MEM_CHECK}MemCheck,{$ENDIF}
+  Classes, SysUtils;
+
+type
+  TAVLTreeNode = class
+  public
+    Parent, Left, Right: TAVLTreeNode;
+    Balance: integer;
+    Data: Pointer;
+    procedure Clear;
+    function TreeDepth: integer; // longest WAY down. e.g. only one node => 0 !
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  TAVLTree = class
+  private
+    FOnCompare: TListSortCompare;
+    FCount: integer;
+    procedure BalanceAfterInsert(ANode: TAVLTreeNode);
+    procedure BalanceAfterDelete(ANode: TAVLTreeNode);
+    function FindInsertPos(Data: Pointer): TAVLTreeNode;
+    procedure SetOnCompare(const AValue: TListSortCompare);
+  public
+    Root: TAVLTreeNode;
+    function Find(Data: Pointer): TAVLTreeNode;
+    function FindKey(Key: Pointer;
+      OnCompareKeyWithData: TListSortCompare): TAVLTreeNode;
+    function FindSuccessor(ANode: TAVLTreeNode): TAVLTreeNode;
+    function FindPrecessor(ANode: TAVLTreeNode): TAVLTreeNode;
+    function FindLowest: TAVLTreeNode;
+    function FindHighest: TAVLTreeNode;
+    function FindNearest(Data: Pointer): TAVLTreeNode;
+    function FindPointer(Data: Pointer): TAVLTreeNode;
+    function FindLeftMost(Data: Pointer): TAVLTreeNode;
+    function FindRightMost(Data: Pointer): TAVLTreeNode;
+    function FindLeftMostKey(Key: Pointer;
+      OnCompareKeyWithData: TListSortCompare): TAVLTreeNode;
+    function FindRightMostKey(Key: Pointer;
+      OnCompareKeyWithData: TListSortCompare): TAVLTreeNode;
+    function FindLeftMostSameKey(ANode: TAVLTreeNode): TAVLTreeNode;
+    function FindRightMostSameKey(ANode: TAVLTreeNode): TAVLTreeNode;
+    procedure Add(ANode: TAVLTreeNode);
+    function Add(Data: Pointer): TAVLTreeNode;
+    procedure Delete(ANode: TAVLTreeNode);
+    procedure Remove(Data: Pointer);
+    procedure RemovePointer(Data: Pointer);
+    procedure MoveDataLeftMost(var ANode: TAVLTreeNode);
+    procedure MoveDataRightMost(var ANode: TAVLTreeNode);
+    property OnCompare: TListSortCompare read FOnCompare write SetOnCompare;
+    procedure Clear;
+    procedure FreeAndClear;
+    procedure FreeAndDelete(ANode: TAVLTreeNode);
+    property Count: integer read FCount;
+    function ConsistencyCheck: integer;
+    procedure WriteReportToStream(s: TStream; var StreamSize: int64);
+    function ReportAsString: string;
+    constructor Create(OnCompareMethod: TListSortCompare);
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  TAVLTreeNodeMemManager = class
+  private
+    FFirstFree: TAVLTreeNode;
+    FFreeCount: integer;
+    FCount: integer;
+    FMinFree: integer;
+    FMaxFreeRatio: integer;
+    procedure SetMaxFreeRatio(NewValue: integer);
+    procedure SetMinFree(NewValue: integer);
+    procedure DisposeFirstFreeNode;
+  public
+    procedure DisposeNode(ANode: TAVLTreeNode);
+    function NewNode: TAVLTreeNode;
+    property MinimumFreeNode: integer read FMinFree write SetMinFree;
+    property MaximumFreeNodeRatio: integer
+        read FMaxFreeRatio write SetMaxFreeRatio; // in one eighth steps
+    property Count: integer read FCount;
+    procedure Clear;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+
+implementation
+
+
+var NodeMemManager: TAVLTreeNodeMemManager;
+
+
+function ComparePointer(Data1, Data2: Pointer): integer;
+begin
+  if Data1>Data2 then Result:=-1
+  else if Data1<Data2 then Result:=1
+  else Result:=0;
+end;
+
+{ TAVLTree }
+
+function TAVLTree.Add(Data: Pointer): TAVLTreeNode;
+begin
+  Result:=NodeMemManager.NewNode;
+  Result.Data:=Data;
+  Add(Result);
+end;
+
+procedure TAVLTree.Add(ANode: TAVLTreeNode);
+// add a node. If there are already nodes with the same value it will be
+// inserted rightmost
+var InsertPos: TAVLTreeNode;
+  InsertComp: integer;
+begin
+  ANode.Left:=nil;
+  ANode.Right:=nil;
+  inc(FCount);
+  if Root<>nil then begin
+    InsertPos:=FindInsertPos(ANode.Data);
+    InsertComp:=fOnCompare(ANode.Data,InsertPos.Data);
+    ANode.Parent:=InsertPos;
+    if InsertComp<0 then begin
+      // insert to the left
+      InsertPos.Left:=ANode;
+    end else begin
+      // insert to the right
+      InsertPos.Right:=ANode;
+    end;
+    BalanceAfterInsert(ANode);
+  end else begin
+    Root:=ANode;
+    ANode.Parent:=nil;
+  end;
+end;
+
+function TAVLTree.FindLowest: TAVLTreeNode;
+begin
+  Result:=Root;
+  if Result<>nil then
+    while Result.Left<>nil do Result:=Result.Left;
+end;
+
+function TAVLTree.FindHighest: TAVLTreeNode;
+begin
+  Result:=Root;
+  if Result<>nil then
+    while Result.Right<>nil do Result:=Result.Right;
+end;
+    
+procedure TAVLTree.BalanceAfterDelete(ANode: TAVLTreeNode);
+var OldParent, OldRight, OldRightLeft, OldLeft, OldLeftRight,
+  OldRightLeftLeft, OldRightLeftRight, OldLeftRightLeft, OldLeftRightRight
+  : TAVLTreeNode;
+begin
+  if (ANode=nil) then exit;
+  if ((ANode.Balance=+1) or (ANode.Balance=-1)) then exit;
+  OldParent:=ANode.Parent;
+  if (ANode.Balance=0) then begin
+    // Treeheight has decreased by one
+    if (OldParent<>nil) then begin
+      if(OldParent.Left=ANode) then
+        Inc(OldParent.Balance)
+      else
+        Dec(OldParent.Balance);
+      BalanceAfterDelete(OldParent);
+    end;
+    exit;
+  end;
+  if (ANode.Balance=+2) then begin
+    // Node is overweighted to the right
+    OldRight:=ANode.Right;
+    if (OldRight.Balance>=0) then begin
+      // OldRight.Balance=={0 or -1}
+      // rotate left
+      OldRightLeft:=OldRight.Left;
+      if (OldParent<>nil) then begin
+        if (OldParent.Left=ANode) then
+          OldParent.Left:=OldRight
+        else
+          OldParent.Right:=OldRight;
+      end else
+        Root:=OldRight;
+      ANode.Parent:=OldRight;
+      ANode.Right:=OldRightLeft;
+      OldRight.Parent:=OldParent;
+      OldRight.Left:=ANode;
+      if (OldRightLeft<>nil) then
+        OldRightLeft.Parent:=ANode;
+      ANode.Balance:=(1-OldRight.Balance);
+      Dec(OldRight.Balance);
+      BalanceAfterDelete(OldRight);
+    end else begin
+      // OldRight.Balance=-1
+      // double rotate right left
+      OldRightLeft:=OldRight.Left;
+      OldRightLeftLeft:=OldRightLeft.Left;
+      OldRightLeftRight:=OldRightLeft.Right;
+      if (OldParent<>nil) then begin
+        if (OldParent.Left=ANode) then
+          OldParent.Left:=OldRightLeft
+        else
+          OldParent.Right:=OldRightLeft;
+      end else
+        Root:=OldRightLeft;
+      ANode.Parent:=OldRightLeft;
+      ANode.Right:=OldRightLeftLeft;
+      OldRight.Parent:=OldRightLeft;
+      OldRight.Left:=OldRightLeftRight;
+      OldRightLeft.Parent:=OldParent;
+      OldRightLeft.Left:=ANode;
+      OldRightLeft.Right:=OldRight;
+      if (OldRightLeftLeft<>nil) then
+        OldRightLeftLeft.Parent:=ANode;
+      if (OldRightLeftRight<>nil) then
+        OldRightLeftRight.Parent:=OldRight;
+      if (OldRightLeft.Balance<=0) then
+        ANode.Balance:=0
+      else
+        ANode.Balance:=-1;
+      if (OldRightLeft.Balance>=0) then
+        OldRight.Balance:=0
+      else
+        OldRight.Balance:=+1;
+      OldRightLeft.Balance:=0;
+      BalanceAfterDelete(OldRightLeft);
+    end;
+  end else begin
+    // Node.Balance=-2
+    // Node is overweighted to the left
+    OldLeft:=ANode.Left;
+    if (OldLeft.Balance<=0) then begin
+      // rotate right
+      OldLeftRight:=OldLeft.Right;
+      if (OldParent<>nil) then begin
+        if (OldParent.Left=ANode) then
+          OldParent.Left:=OldLeft
+        else
+          OldParent.Right:=OldLeft;
+      end else
+        Root:=OldLeft;
+      ANode.Parent:=OldLeft;
+      ANode.Left:=OldLeftRight;
+      OldLeft.Parent:=OldParent;
+      OldLeft.Right:=ANode;
+      if (OldLeftRight<>nil) then
+        OldLeftRight.Parent:=ANode;
+      ANode.Balance:=(-1-OldLeft.Balance);
+      Inc(OldLeft.Balance);
+      BalanceAfterDelete(OldLeft);
+    end else begin
+      // OldLeft.Balance = 1
+      // double rotate left right
+      OldLeftRight:=OldLeft.Right;
+      OldLeftRightLeft:=OldLeftRight.Left;
+      OldLeftRightRight:=OldLeftRight.Right;
+      if (OldParent<>nil) then begin
+        if (OldParent.Left=ANode) then
+          OldParent.Left:=OldLeftRight
+        else
+          OldParent.Right:=OldLeftRight;
+      end else
+        Root:=OldLeftRight;
+      ANode.Parent:=OldLeftRight;
+      ANode.Left:=OldLeftRightRight;
+      OldLeft.Parent:=OldLeftRight;
+      OldLeft.Right:=OldLeftRightLeft;
+      OldLeftRight.Parent:=OldParent;
+      OldLeftRight.Left:=OldLeft;
+      OldLeftRight.Right:=ANode;
+      if (OldLeftRightLeft<>nil) then
+        OldLeftRightLeft.Parent:=OldLeft;
+      if (OldLeftRightRight<>nil) then
+        OldLeftRightRight.Parent:=ANode;
+      if (OldLeftRight.Balance>=0) then
+        ANode.Balance:=0
+      else
+        ANode.Balance:=+1;
+      if (OldLeftRight.Balance<=0) then
+        OldLeft.Balance:=0
+      else
+        OldLeft.Balance:=-1;
+      OldLeftRight.Balance:=0;
+      BalanceAfterDelete(OldLeftRight);
+    end;
+  end;
+end;
+
+procedure TAVLTree.BalanceAfterInsert(ANode: TAVLTreeNode);
+var OldParent, OldParentParent, OldRight, OldRightLeft, OldRightRight, OldLeft,
+   OldLeftLeft, OldLeftRight: TAVLTreeNode;
+begin
+  OldParent:=ANode.Parent;
+  if (OldParent=nil) then exit;
+  if (OldParent.Left=ANode) then begin
+    // Node is left son
+    dec(OldParent.Balance);
+    if (OldParent.Balance=0) then exit;
+    if (OldParent.Balance=-1) then begin
+      BalanceAfterInsert(OldParent);
+      exit;
+    end;
+    // OldParent.Balance=-2
+    if (ANode.Balance=-1) then begin
+      // rotate
+      OldRight:=ANode.Right;
+      OldParentParent:=OldParent.Parent;
+      if (OldParentParent<>nil) then begin
+        // OldParent has GrandParent. GrandParent gets new child
+        if (OldParentParent.Left=OldParent) then
+          OldParentParent.Left:=ANode
+        else
+          OldParentParent.Right:=ANode;
+      end else begin
+        // OldParent was root node. New root node
+        Root:=ANode;
+      end;
+      ANode.Parent:=OldParentParent;
+      ANode.Right:=OldParent;
+      OldParent.Parent:=ANode;
+      OldParent.Left:=OldRight;
+      if (OldRight<>nil) then
+        OldRight.Parent:=OldParent;
+      ANode.Balance:=0;
+      OldParent.Balance:=0;
+    end else begin
+      // Node.Balance = +1
+      // double rotate
+      OldParentParent:=OldParent.Parent;
+      OldRight:=ANode.Right;
+      OldRightLeft:=OldRight.Left;
+      OldRightRight:=OldRight.Right;
+      if (OldParentParent<>nil) then begin
+        // OldParent has GrandParent. GrandParent gets new child
+        if (OldParentParent.Left=OldParent) then
+          OldParentParent.Left:=OldRight
+        else
+          OldParentParent.Right:=OldRight;
+      end else begin
+        // OldParent was root node. new root node
+        Root:=OldRight;
+      end;
+      OldRight.Parent:=OldParentParent;
+      OldRight.Left:=ANode;
+      OldRight.Right:=OldParent;
+      ANode.Parent:=OldRight;
+      ANode.Right:=OldRightLeft;
+      OldParent.Parent:=OldRight;
+      OldParent.Left:=OldRightRight;
+      if (OldRightLeft<>nil) then
+        OldRightLeft.Parent:=ANode;
+      if (OldRightRight<>nil) then
+        OldRightRight.Parent:=OldParent;
+      if (OldRight.Balance<=0) then
+        ANode.Balance:=0
+      else
+        ANode.Balance:=-1;
+      if (OldRight.Balance=-1) then
+        OldParent.Balance:=1
+      else
+        OldParent.Balance:=0;
+      OldRight.Balance:=0;
+    end;
+  end else begin
+    // Node is right son
+    Inc(OldParent.Balance);
+    if (OldParent.Balance=0) then exit;
+    if (OldParent.Balance=+1) then begin
+      BalanceAfterInsert(OldParent);
+      exit;
+    end;
+    // OldParent.Balance = +2
+    if(ANode.Balance=+1) then begin
+      // rotate
+      OldLeft:=ANode.Left;
+      OldParentParent:=OldParent.Parent;
+      if (OldParentParent<>nil) then begin
+        // Parent has GrandParent . GrandParent gets new child
+        if(OldParentParent.Left=OldParent) then
+          OldParentParent.Left:=ANode
+        else
+          OldParentParent.Right:=ANode;
+      end else begin
+        // OldParent was root node . new root node
+        Root:=ANode;
+      end;
+      ANode.Parent:=OldParentParent;
+      ANode.Left:=OldParent;
+      OldParent.Parent:=ANode;
+      OldParent.Right:=OldLeft;
+      if (OldLeft<>nil) then
+        OldLeft.Parent:=OldParent;
+      ANode.Balance:=0;
+      OldParent.Balance:=0;
+    end else begin
+      // Node.Balance = -1
+      // double rotate
+      OldLeft:=ANode.Left;
+      OldParentParent:=OldParent.Parent;
+      OldLeftLeft:=OldLeft.Left;
+      OldLeftRight:=OldLeft.Right;
+      if (OldParentParent<>nil) then begin
+        // OldParent has GrandParent . GrandParent gets new child
+        if (OldParentParent.Left=OldParent) then
+          OldParentParent.Left:=OldLeft
+        else
+          OldParentParent.Right:=OldLeft;
+      end else begin
+        // OldParent was root node . new root node
+        Root:=OldLeft;
+      end;
+      OldLeft.Parent:=OldParentParent;
+      OldLeft.Left:=OldParent;
+      OldLeft.Right:=ANode;
+      ANode.Parent:=OldLeft;
+      ANode.Left:=OldLeftRight;
+      OldParent.Parent:=OldLeft;
+      OldParent.Right:=OldLeftLeft;
+      if (OldLeftLeft<>nil) then
+        OldLeftLeft.Parent:=OldParent;
+      if (OldLeftRight<>nil) then
+        OldLeftRight.Parent:=ANode;
+      if (OldLeft.Balance>=0) then
+        ANode.Balance:=0
+      else
+        ANode.Balance:=+1;
+      if (OldLeft.Balance=+1) then
+        OldParent.Balance:=-1
+      else
+        OldParent.Balance:=0;
+      OldLeft.Balance:=0;
+    end;
+  end;
+end;
+
+procedure TAVLTree.Clear;
+
+  procedure DeleteNode(ANode: TAVLTreeNode);
+  begin
+    if ANode<>nil then begin
+      if ANode.Left<>nil then DeleteNode(ANode.Left);
+      if ANode.Right<>nil then DeleteNode(ANode.Right);
+    end;
+    NodeMemManager.DisposeNode(ANode);
+  end;
+
+// Clear
+begin
+  DeleteNode(Root);
+  Root:=nil;
+  FCount:=0;
+end;
+
+constructor TAVLTree.Create(OnCompareMethod: TListSortCompare);
+begin
+  inherited Create;
+  FOnCompare:=OnCompareMethod;
+  FCount:=0;
+end;
+
+constructor TAVLTree.Create;
+begin
+  Create(@ComparePointer);
+end;
+
+procedure TAVLTree.Delete(ANode: TAVLTreeNode);
+var OldParent, OldLeft, OldRight, Successor, OldSuccParent, OldSuccLeft,
+  OldSuccRight: TAVLTreeNode;
+  OldBalance: integer;
+begin
+  OldParent:=ANode.Parent;
+  OldBalance:=ANode.Balance;
+  ANode.Parent:=nil;
+  ANode.Balance:=0;
+  if ((ANode.Left=nil) and (ANode.Right=nil)) then begin
+    // Node is Leaf (no children)
+    if (OldParent<>nil) then begin
+      // Node has parent
+      if (OldParent.Left=ANode) then begin
+        // Node is left Son of OldParent
+        OldParent.Left:=nil;
+        Inc(OldParent.Balance);
+      end else begin
+        // Node is right Son of OldParent
+        OldParent.Right:=nil;
+        Dec(OldParent.Balance);
+      end;
+      BalanceAfterDelete(OldParent);
+    end else begin
+      // Node is the only node of tree
+      Root:=nil;
+    end;
+    dec(FCount);
+    NodeMemManager.DisposeNode(ANode);
+    exit;
+  end;
+  if (ANode.Right=nil) then begin
+    // Left is only son
+    // and because DelNode is AVL, Right has no childrens
+    // replace DelNode with Left
+    OldLeft:=ANode.Left;
+    ANode.Left:=nil;
+    OldLeft.Parent:=OldParent;
+    if (OldParent<>nil) then begin
+      if (OldParent.Left=ANode) then begin
+        OldParent.Left:=OldLeft;
+        Inc(OldParent.Balance);
+      end else begin
+        OldParent.Right:=OldLeft;
+        Dec(OldParent.Balance);
+      end;
+      BalanceAfterDelete(OldParent);
+    end else begin
+      Root:=OldLeft;
+    end;
+    dec(FCount);
+    NodeMemManager.DisposeNode(ANode);
+    exit;
+  end;
+  if (ANode.Left=nil) then begin
+    // Right is only son
+    // and because DelNode is AVL, Left has no childrens
+    // replace DelNode with Right
+    OldRight:=ANode.Right;
+    ANode.Right:=nil;
+    OldRight.Parent:=OldParent;
+    if (OldParent<>nil) then begin
+      if (OldParent.Left=ANode) then begin
+        OldParent.Left:=OldRight;
+        Inc(OldParent.Balance);
+      end else begin
+        OldParent.Right:=OldRight;
+        Dec(OldParent.Balance);
+      end;
+      BalanceAfterDelete(OldParent);
+    end else begin
+      Root:=OldRight;
+    end;
+    dec(FCount);
+    NodeMemManager.DisposeNode(ANode);
+    exit;
+  end;
+  // DelNode has both: Left and Right
+  // Replace ANode with symmetric Successor
+  Successor:=FindSuccessor(ANode);
+  OldLeft:=ANode.Left;
+  OldRight:=ANode.Right;
+  OldSuccParent:=Successor.Parent;
+  OldSuccLeft:=Successor.Left;
+  OldSuccRight:=Successor.Right;
+  ANode.Balance:=Successor.Balance;
+  Successor.Balance:=OldBalance;
+  if (OldSuccParent<>ANode) then begin
+    // at least one node between ANode and Successor
+    ANode.Parent:=Successor.Parent;
+    if (OldSuccParent.Left=Successor) then
+      OldSuccParent.Left:=ANode
+    else
+      OldSuccParent.Right:=ANode;
+    Successor.Right:=OldRight;
+    OldRight.Parent:=Successor;
+  end else begin
+    // Successor is right son of ANode
+    ANode.Parent:=Successor;
+    Successor.Right:=ANode;
+  end;
+  Successor.Left:=OldLeft;
+  if OldLeft<>nil then
+    OldLeft.Parent:=Successor;
+  Successor.Parent:=OldParent;
+  ANode.Left:=OldSuccLeft;
+  if ANode.Left<>nil then
+    ANode.Left.Parent:=ANode;
+  ANode.Right:=OldSuccRight;
+  if ANode.Right<>nil then
+    ANode.Right.Parent:=ANode;
+  if (OldParent<>nil) then begin
+    if (OldParent.Left=ANode) then
+      OldParent.Left:=Successor
+    else
+      OldParent.Right:=Successor;
+  end else
+    Root:=Successor;
+  // delete Node as usual
+  Delete(ANode);
+end;
+
+procedure TAVLTree.Remove(Data: Pointer);
+var ANode: TAVLTreeNode;
+begin
+  ANode:=Find(Data);
+  if ANode<>nil then
+    Delete(ANode);
+end;
+
+procedure TAVLTree.RemovePointer(Data: Pointer);
+var
+  ANode: TAVLTreeNode;
+begin
+  ANode:=FindPointer(Data);
+  if ANode<>nil then
+    Delete(ANode);
+end;
+
+destructor TAVLTree.Destroy;
+begin
+  Clear;
+  inherited Destroy;
+end;
+
+function TAVLTree.Find(Data: Pointer): TAVLTreeNode;
+var Comp: integer;
+begin
+  Result:=Root;
+  while (Result<>nil) do begin
+    Comp:=fOnCompare(Data,Result.Data);
+    if Comp=0 then exit;
+    if Comp<0 then begin
+      Result:=Result.Left
+    end else begin
+      Result:=Result.Right
+    end;
+  end;
+end;
+
+function TAVLTree.FindKey(Key: Pointer; OnCompareKeyWithData: TListSortCompare
+  ): TAVLTreeNode;
+var Comp: integer;
+begin
+  Result:=Root;
+  while (Result<>nil) do begin
+    Comp:=OnCompareKeyWithData(Key,Result.Data);
+    if Comp=0 then exit;
+    if Comp<0 then begin
+      Result:=Result.Left
+    end else begin
+      Result:=Result.Right
+    end;
+  end;
+end;
+
+function TAVLTree.FindLeftMostKey(Key: Pointer;
+  OnCompareKeyWithData: TListSortCompare): TAVLTreeNode;
+begin
+  Result:=FindLeftMostSameKey(FindKey(Key,OnCompareKeyWithData));
+end;
+
+function TAVLTree.FindRightMostKey(Key: Pointer;
+  OnCompareKeyWithData: TListSortCompare): TAVLTreeNode;
+begin
+  Result:=FindRightMostSameKey(FindKey(Key,OnCompareKeyWithData));
+end;
+
+function TAVLTree.FindLeftMostSameKey(ANode: TAVLTreeNode): TAVLTreeNode;
+var
+  LeftNode: TAVLTreeNode;
+  Data: Pointer;
+begin
+  if ANode<>nil then begin
+    Data:=ANode.Data;
+    Result:=ANode;
+    repeat
+      LeftNode:=FindPrecessor(Result);
+      if (LeftNode=nil) or (fOnCompare(Data,LeftNode.Data)<>0) then break;
+      Result:=LeftNode;
+    until false;
+  end else begin
+    Result:=nil;
+  end;
+end;
+
+function TAVLTree.FindRightMostSameKey(ANode: TAVLTreeNode): TAVLTreeNode;
+var
+  RightNode: TAVLTreeNode;
+  Data: Pointer;
+begin
+  if ANode<>nil then begin
+    Data:=ANode.Data;
+    Result:=ANode;
+    repeat
+      RightNode:=FindSuccessor(Result);
+      if (RightNode=nil) or (fOnCompare(Data,RightNode.Data)<>0) then break;
+      Result:=RightNode;
+    until false;
+  end else begin
+    Result:=nil;
+  end;
+end;
+
+function TAVLTree.FindNearest(Data: Pointer): TAVLTreeNode;
+var Comp: integer;
+begin
+  Result:=Root;
+  while (Result<>nil) do begin
+    Comp:=fOnCompare(Data,Result.Data);
+    if Comp=0 then exit;
+    if Comp<0 then begin
+      if Result.Left<>nil then
+        Result:=Result.Left
+      else
+        exit;
+    end else begin
+      if Result.Right<>nil then
+        Result:=Result.Right
+      else
+        exit;
+    end;
+  end;
+end;
+
+function TAVLTree.FindPointer(Data: Pointer): TAVLTreeNode;
+begin
+  Result:=FindLeftMost(Data);
+  while (Result<>nil) do begin
+    if Result.Data=Data then break;
+    Result:=FindSuccessor(Result);
+    if fOnCompare(Data,Result.Data)<>0 then Result:=nil;
+  end;
+end;
+
+function TAVLTree.FindLeftMost(Data: Pointer): TAVLTreeNode;
+var
+  Left: TAVLTreeNode;
+begin
+  Result:=Find(Data);
+  while (Result<>nil) do begin
+    Left:=FindPrecessor(Result);
+    if (Left=nil) or (fOnCompare(Data,Left.Data)<>0) then break;
+    Result:=Left;
+  end;
+end;
+
+function TAVLTree.FindRightMost(Data: Pointer): TAVLTreeNode;
+var
+  Right: TAVLTreeNode;
+begin
+  Result:=Find(Data);
+  while (Result<>nil) do begin
+    Right:=FindSuccessor(Result);
+    if (Right=nil) or (fOnCompare(Data,Right.Data)<>0) then break;
+    Result:=Right;
+  end;
+end;
+
+function TAVLTree.FindInsertPos(Data: Pointer): TAVLTreeNode;
+var Comp: integer;
+begin
+  Result:=Root;
+  while (Result<>nil) do begin
+    Comp:=fOnCompare(Data,Result.Data);
+    if Comp<0 then begin
+      if Result.Left<>nil then
+        Result:=Result.Left
+      else
+        exit;
+    end else begin
+      if Result.Right<>nil then
+        Result:=Result.Right
+      else
+        exit;
+    end;
+  end;
+end;
+
+function TAVLTree.FindSuccessor(ANode: TAVLTreeNode): TAVLTreeNode;
+begin
+  Result:=ANode.Right;
+  if Result<>nil then begin
+    while (Result.Left<>nil) do Result:=Result.Left;
+  end else begin
+    Result:=ANode;
+    while (Result.Parent<>nil) and (Result.Parent.Right=Result) do
+      Result:=Result.Parent;
+    Result:=Result.Parent;
+  end;
+end;
+
+function TAVLTree.FindPrecessor(ANode: TAVLTreeNode): TAVLTreeNode;
+begin
+  Result:=ANode.Left;
+  if Result<>nil then begin
+    while (Result.Right<>nil) do Result:=Result.Right;
+  end else begin
+    Result:=ANode;
+    while (Result.Parent<>nil) and (Result.Parent.Left=Result) do
+      Result:=Result.Parent;
+    Result:=Result.Parent;
+  end;
+end;
+
+procedure TAVLTree.MoveDataLeftMost(var ANode: TAVLTreeNode);
+var LeftMost, PreNode: TAVLTreeNode;
+  Data: Pointer;
+begin
+  if ANode=nil then exit;
+  LeftMost:=ANode;
+  repeat
+    PreNode:=FindPrecessor(LeftMost);
+    if (PreNode=nil) or (FOnCompare(ANode,PreNode)<>0) then break;
+    LeftMost:=PreNode;
+  until false;
+  if LeftMost=ANode then exit;
+  Data:=LeftMost.Data;
+  LeftMost.Data:=ANode.Data;
+  ANode.Data:=Data;
+  ANode:=LeftMost;
+end;
+
+procedure TAVLTree.MoveDataRightMost(var ANode: TAVLTreeNode);
+var RightMost, PostNode: TAVLTreeNode;
+  Data: Pointer;
+begin
+  if ANode=nil then exit;
+  RightMost:=ANode;
+  repeat
+    PostNode:=FindSuccessor(RightMost);
+    if (PostNode=nil) or (FOnCompare(ANode,PostNode)<>0) then break;
+    RightMost:=PostNode;
+  until false;
+  if RightMost=ANode then exit;
+  Data:=RightMost.Data;
+  RightMost.Data:=ANode.Data;
+  ANode.Data:=Data;
+  ANode:=RightMost;
+end;
+
+function TAVLTree.ConsistencyCheck: integer;
+var RealCount: integer;
+
+  function CheckNode(ANode: TAVLTreeNode): integer;
+  var LeftDepth, RightDepth: integer;
+  begin
+    if ANode=nil then begin
+      Result:=0;
+      exit;
+    end;
+    inc(RealCount);
+    // test left son
+    if ANode.Left<>nil then begin
+      if ANode.Left.Parent<>ANode then begin
+        Result:=-2;  exit;
+      end;
+      if fOnCompare(ANode.Left.Data,ANode.Data)>0 then begin
+        //DebugLn('CCC-3 ',HexStr(Cardinal(ANode.Data),8),' ',HexStr(Cardinal(ANode.Left.Data),8));
+        Result:=-3;  exit;
+      end;
+      Result:=CheckNode(ANode.Left);
+      if Result<>0 then exit;
+    end;
+    // test right son
+    if ANode.Right<>nil then begin
+      if ANode.Right.Parent<>ANode then begin
+        Result:=-4;  exit;
+      end;
+      if fOnCompare(ANode.Data,ANode.Right.Data)>0 then begin
+        //DebugLn('CCC-5 ',HexStr(Cardinal(ANode.Data),8),' ',HexStr(Cardinal(ANode.Right.Data),8));
+        Result:=-5;  exit;
+      end;
+      Result:=CheckNode(ANode.Right);
+      if Result<>0 then exit;
+    end;
+    // test balance
+    if ANode.Left<>nil then
+      LeftDepth:=ANode.Left.TreeDepth+1
+    else
+      LeftDepth:=0;
+    if ANode.Right<>nil then
+      RightDepth:=ANode.Right.TreeDepth+1
+    else
+      RightDepth:=0;
+    if ANode.Balance<>(RightDepth-LeftDepth) then begin
+      Result:=-6;  exit;
+    end;
+    // ok
+    Result:=0;
+  end;
+
+// TAVLTree.ConsistencyCheck
+begin
+  RealCount:=0;
+  Result:=CheckNode(Root);
+  if Result<>0 then exit;
+  if FCount<>RealCount then begin
+    Result:=-1;
+    exit;
+  end;
+end;
+
+procedure TAVLTree.FreeAndClear;
+
+  procedure FreeNode(ANode: TAVLTreeNode);
+  begin
+    if ANode=nil then exit;
+    FreeNode(ANode.Left);
+    FreeNode(ANode.Right);
+    if ANode.Data<>nil then TObject(ANode.Data).Free;
+    ANode.Data:=nil;
+  end;
+
+// TAVLTree.FreeAndClear
+begin
+  // free all data
+  FreeNode(Root);
+  // free all nodes
+  Clear;
+end;
+
+procedure TAVLTree.FreeAndDelete(ANode: TAVLTreeNode);
+var OldData: TObject;
+begin
+  OldData:=TObject(ANode.Data);
+  Delete(ANode);
+  OldData.Free;
+end;
+
+procedure TAVLTree.WriteReportToStream(s: TStream; var StreamSize: int64);
+var h: string;
+
+  procedure WriteStr(const Txt: string);
+  begin
+    if s<>nil then
+      s.Write(Txt[1],length(Txt));
+    inc(StreamSize,length(Txt));
+  end;
+
+  procedure WriteTreeNode(ANode: TAVLTreeNode; const Prefix: string);
+  var b: string;
+  begin
+    if ANode=nil then exit;
+    WriteTreeNode(ANode.Right,Prefix+'  ');
+    b:=Prefix+HexStr(Cardinal(ANode.Data),8)+'    '
+        +'  Self='+HexStr(Cardinal(ANode),8)
+        +'  Parent='+HexStr(Cardinal(ANode.Parent),8)
+        +'  Balance='+IntToStr(ANode.Balance)
+        +#13#10;
+    WriteStr(b);
+    WriteTreeNode(ANode.Left,Prefix+'  ');
+  end;
+
+// TAVLTree.WriteReportToStream
+begin
+  h:='Consistency: '+IntToStr(ConsistencyCheck)+' ---------------------'+#13#10;
+  WriteStr(h);
+  WriteTreeNode(Root,'  ');
+  h:='-End-Of-AVL-Tree---------------------'+#13#10;
+  WriteStr(h);
+end;
+
+function TAVLTree.ReportAsString: string;
+var ms: TMemoryStream;
+  StreamSize: int64;
+begin
+  Result:='';
+  ms:=TMemoryStream.Create;
+  try
+    StreamSize:=0;
+    WriteReportToStream(nil,StreamSize);
+    ms.Size:=StreamSize;
+    StreamSize:=0;
+    WriteReportToStream(ms,StreamSize);
+    StreamSize:=0;
+    if StreamSize>0 then begin
+      ms.Position:=0;
+      SetLength(Result,StreamSize);
+      ms.Read(Result[1],StreamSize);
+    end;
+  finally
+    ms.Free;
+  end;
+end;
+
+procedure TAVLTree.SetOnCompare(const AValue: TListSortCompare);
+var List: PPointer;
+  ANode: TAVLTreeNode;
+  i, OldCount: integer;
+begin
+  if FOnCompare=AValue then exit;
+  // sort the tree again
+  if Count>0 then begin
+    OldCount:=Count;
+    GetMem(List,SizeOf(Pointer)*OldCount);
+    try
+      // save the data in a list
+      ANode:=FindLowest;
+      i:=0;
+      while ANode<>nil do begin
+        List[i]:=ANode.Data;
+        inc(i);
+        ANode:=FindSuccessor(ANode);
+      end;
+      // clear the tree
+      Clear;
+      // set the new compare function
+      FOnCompare:=AValue;
+      // re-add all nodes
+      for i:=0 to OldCount-1 do
+        Add(List[i]);
+    finally
+      FreeMem(List);
+    end;
+  end;
+end;
+
+
+{ TAVLTreeNode }
+
+constructor TAVLTreeNode.Create;
+begin
+  inherited Create;
+
+end;
+
+destructor TAVLTreeNode.Destroy;
+begin
+
+  inherited Destroy;
+end;
+
+function TAVLTreeNode.TreeDepth: integer;
+// longest WAY down. e.g. only one node => 0 !
+var LeftDepth, RightDepth: integer;
+begin
+  if Left<>nil then
+    LeftDepth:=Left.TreeDepth+1
+  else
+    LeftDepth:=0;
+  if Right<>nil then
+    RightDepth:=Right.TreeDepth+1
+  else
+    RightDepth:=0;
+  if LeftDepth>RightDepth then
+    Result:=LeftDepth
+  else
+    Result:=RightDepth;
+end;
+
+procedure TAVLTreeNode.Clear;
+begin
+  Parent:=nil;
+  Left:=nil;
+  Right:=nil;
+  Balance:=0;
+  Data:=nil;
+end;
+
+{ TAVLTreeNodeMemManager }
+
+constructor TAVLTreeNodeMemManager.Create;
+begin
+  inherited Create;
+  FFirstFree:=nil;
+  FFreeCount:=0;
+  FCount:=0;
+  FMinFree:=100;
+  FMaxFreeRatio:=8; // 1:1
+end;
+
+destructor TAVLTreeNodeMemManager.Destroy;
+begin
+  Clear;
+  inherited Destroy;
+end;
+
+procedure TAVLTreeNodeMemManager.DisposeNode(ANode: TAVLTreeNode);
+begin
+  if ANode=nil then exit;
+  if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
+  begin
+    // add ANode to Free list
+    ANode.Clear;
+    ANode.Right:=FFirstFree;
+    FFirstFree:=ANode;
+    inc(FFreeCount);
+    if (FFreeCount>(((8+FMaxFreeRatio)*FCount) shr 3)) then begin
+      DisposeFirstFreeNode;
+      DisposeFirstFreeNode;
+    end;
+  end else begin
+    // free list full -> free the ANode
+    ANode.Free;
+  end;
+  dec(FCount);
+end;
+
+function TAVLTreeNodeMemManager.NewNode: TAVLTreeNode;
+begin
+  if FFirstFree<>nil then begin
+    // take from free list
+    Result:=FFirstFree;
+    FFirstFree:=FFirstFree.Right;
+    Result.Right:=nil;
+  end else begin
+    // free list empty -> create new node
+    Result:=TAVLTreeNode.Create;
+  end;
+  inc(FCount);
+end;
+
+procedure TAVLTreeNodeMemManager.Clear;
+var ANode: TAVLTreeNode;
+begin
+  while FFirstFree<>nil do begin
+    ANode:=FFirstFree;
+    FFirstFree:=FFirstFree.Right;
+    ANode.Right:=nil;
+    ANode.Free;
+  end;
+  FFreeCount:=0;
+end;
+
+procedure TAVLTreeNodeMemManager.SetMaxFreeRatio(NewValue: integer);
+begin
+  if NewValue<0 then NewValue:=0;
+  if NewValue=FMaxFreeRatio then exit;
+  FMaxFreeRatio:=NewValue;
+end;
+
+procedure TAVLTreeNodeMemManager.SetMinFree(NewValue: integer);
+begin
+  if NewValue<0 then NewValue:=0;
+  if NewValue=FMinFree then exit;
+  FMinFree:=NewValue;
+end;
+
+procedure TAVLTreeNodeMemManager.DisposeFirstFreeNode;
+var OldNode: TAVLTreeNode;
+begin
+  if FFirstFree=nil then exit;
+  OldNode:=FFirstFree;
+  FFirstFree:=FFirstFree.Right;
+  dec(FFreeCount);
+  OldNode.Right:=nil;
+  OldNode.Free;
+end;
+
+
+initialization
+
+NodeMemManager:=TAVLTreeNodeMemManager.Create;
+
+finalization
+
+NodeMemManager.Free;
+NodeMemManager:=nil;
+
+end.
+

+ 233 - 131
fcl/xml/dom.pp

@@ -3,7 +3,7 @@
     This file is part of the Free Component Library
 
     Implementation of DOM interfaces
-    Copyright (c) 1999-2003 by Sebastian Guenther, [email protected]
+    Copyright (c) 1999-2000 by Sebastian Guenther, [email protected]
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -32,11 +32,37 @@
 
 unit DOM;
 
+{$MODE objfpc}
+{$H+}
+
 interface
 
-uses SysUtils, Classes;
+{off $DEFINE MEM_CHECK}
+
+uses
+  {$IFDEF MEM_CHECK}MemCheck,{$ENDIF}
+  SysUtils, Classes, AVL_Tree;
+
 
 type
+  TDOMImplementation = class;
+  TDOMDocumentFragment = class;
+  TDOMDocument = class;
+  TDOMNode = class;
+  TDOMNodeList = class;
+  TDOMNamedNodeMap = class;
+  TDOMCharacterData = class;
+  TDOMAttr = class;
+  TDOMElement = class;
+  TDOMText = class;
+  TDOMComment = class;
+  TDOMCDATASection = class;
+  TDOMDocumentType = class;
+  TDOMNotation = class;
+  TDOMEntity = class;
+  TDOMEntityReference = class;
+  TDOMProcessingInstruction = class;
+
 
 // -------------------------------------------------------
 //   DOMString
@@ -44,8 +70,10 @@ type
 
 {$IFDEF ver1_0}
   DOMString = String;
+  DOMPChar = PChar;
 {$ELSE}
   DOMString = WideString;
+  DOMPChar = PWideChar;
 {$ENDIF}
 
 
@@ -57,32 +85,31 @@ const
 
   // DOM Level 1 exception codes:
 
-  INDEX_SIZE_ERR              = 1;      // index or size is negative, or greater than the allowed value
-  DOMSTRING_SIZE_ERR          = 2;      // Specified range of text does not fit into a DOMString
-  HIERARCHY_REQUEST_ERR       = 3;      // node is inserted somewhere it does not belong
-  WRONG_DOCUMENT_ERR          = 4;      // node is used in a different document than the one that created it (that does not support it)
-  INVALID_CHARACTER_ERR       = 5;      // invalid or illegal character is specified, such as in a name
-  NO_DATA_ALLOWED_ERR         = 6;      // data is specified for a node which does not support data
-  NO_MODIFICATION_ALLOWED_ERR = 7;      // an attempt is made to modify an object where modifications are not allowed
-  NOT_FOUND_ERR               = 8;      // an attempt is made to reference a node in a context where it does not exist
-  NOT_SUPPORTED_ERR           = 9;      // implementation does not support the type of object requested
-  INUSE_ATTRIBUTE_ERR         = 10;     // an attempt is made to add an attribute that is already in use elsewhere
+  INDEX_SIZE_ERR              = 1;  // index or size is negative, or greater than the allowed value
+  DOMSTRING_SIZE_ERR          = 2;  // Specified range of text does not fit into a DOMString
+  HIERARCHY_REQUEST_ERR       = 3;  // node is inserted somewhere it does not belong
+  WRONG_DOCUMENT_ERR          = 4;  // node is used in a different document than the one that created it (that does not support it)
+  INVALID_CHARACTER_ERR       = 5;  // invalid or illegal character is specified, such as in a name
+  NO_DATA_ALLOWED_ERR         = 6;  // data is specified for a node which does not support data
+  NO_MODIFICATION_ALLOWED_ERR = 7;  // an attempt is made to modify an object where modifications are not allowed
+  NOT_FOUND_ERR               = 8;  // an attempt is made to reference a node in a context where it does not exist
+  NOT_SUPPORTED_ERR           = 9;  // implementation does not support the type of object requested
+  INUSE_ATTRIBUTE_ERR         = 10;  // an attempt is made to add an attribute that is already in use elsewhere
 
   // DOM Level 2 exception codes:
 
-  INVALID_STATE_ERR           = 11;     // an attempt is made to use an object that is not, or is no longer, usable
-  SYNTAX_ERR                  = 12;     // invalid or illegal string specified
-  INVALID_MODIFICATION_ERR    = 13;     // an attempt is made to modify the type of the underlying object
-  NAMESPACE_ERR               = 14;     // an attempt is made to create or change an object in a way which is incorrect with regard to namespaces
-  INVALID_ACCESS_ERR          = 15;     // parameter or operation is not supported by the underlying object
+  INVALID_STATE_ERR           = 11;  // an attempt is made to use an object that is not, or is no longer, usable
+  SYNTAX_ERR                  = 12;  // invalid or illegal string specified
+  INVALID_MODIFICATION_ERR    = 13;  // an attempt is made to modify the type of the underlying object
+  NAMESPACE_ERR               = 14;  // an attempt is made to create or change an object in a way which is incorrect with regard to namespaces
+  INVALID_ACCESS_ERR          = 15;  // parameter or operation is not supported by the underlying object
 
 
 type
 
   EDOMError = class(Exception)
-  protected
-    constructor Create(ACode: Integer; const ASituation: String);
   public
+    constructor Create(ACode: Integer; const ASituation: String);
     Code: Integer;
   end;
 
@@ -163,25 +190,6 @@ const
 
 
 type
-
-  TDOMImplementation = class;
-  TDOMDocumentFragment = class;
-  TDOMDocument = class;
-  TDOMNode = class;
-  TDOMNodeList = class;
-  TDOMNamedNodeMap = class;
-  TDOMCharacterData = class;
-  TDOMAttr = class;
-  TDOMElement = class;
-  TDOMText = class;
-  TDOMComment = class;
-  TDOMCDATASection = class;
-  TDOMDocumentType = class;
-  TDOMNotation = class;
-  TDOMEntity = class;
-  TDOMEntityReference = class;
-  TDOMProcessingInstruction = class;
-
   TRefClass = class
   protected
     RefCounter: LongInt;
@@ -200,13 +208,14 @@ type
     FOwnerDocument: TDOMDocument;
 
     function  GetNodeValue: DOMString; virtual;
-    procedure SetNodeValue(AValue: DOMString); virtual;
+    procedure SetNodeValue(const AValue: DOMString); virtual;
     function  GetFirstChild: TDOMNode; virtual;
     function  GetLastChild: TDOMNode; virtual;
     function  GetAttributes: TDOMNamedNodeMap; virtual;
 
-    constructor Create(AOwner: TDOMDocument);
   public
+    constructor Create(AOwner: TDOMDocument);
+
     // Free NodeList with TDOMNodeList.Release!
     function GetChildNodes: TDOMNodeList; virtual;
 
@@ -230,9 +239,8 @@ type
     function CloneNode(deep: Boolean): TDOMNode; overload;
 
     // Extensions to DOM interface:
-    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
-      overload; virtual;
-    function FindNode(const ANodeName: DOMString): TDOMNode;
+    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; virtual;
+    function FindNode(const ANodeName: DOMString): TDOMNode; virtual;
   end;
 
 
@@ -243,9 +251,12 @@ type
   TDOMNode_WithChildren = class(TDOMNode)
   protected
     FFirstChild, FLastChild: TDOMNode;
+    FChildNodeTree: TAVLTree;
     function GetFirstChild: TDOMNode; override;
     function GetLastChild: TDOMNode; override;
     procedure CloneChildren(ACopy: TDOMNode; ACloneOwner: TDOMDocument);
+    procedure AddToChildNodeTree(NewNode: TDOMNode);
+    procedure RemoveFromChildNodeTree(OldNode: TDOMNode);
   public
     destructor Destroy; override;
     function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; override;
@@ -253,6 +264,7 @@ type
     function RemoveChild(OldChild: TDOMNode): TDOMNode; override;
     function AppendChild(NewChild: TDOMNode): TDOMNode; override;
     function HasChildNodes: Boolean; override;
+    function FindNode(const ANodeName: DOMString): TDOMNode; override;
   end;
 
 
@@ -265,10 +277,10 @@ type
     node: TDOMNode;
     filter: DOMString;
     UseFilter: Boolean;
-    constructor Create(ANode: TDOMNode; AFilter: DOMString);
     function GetCount: LongInt;
     function GetItem(index: LongWord): TDOMNode;
   public
+    constructor Create(ANode: TDOMNode; const AFilter: DOMString);
     property Item[index: LongWord]: TDOMNode read GetItem;
     property Count: LongInt read GetCount;
   end;
@@ -284,9 +296,9 @@ type
     function GetItem(index: LongWord): TDOMNode;
     procedure SetItem(index: LongWord; AItem: TDOMNode);
     function GetLength: LongInt;
-
-    constructor Create(AOwner: TDOMDocument);
   public
+    constructor Create(AOwner: TDOMDocument);
+
     function GetNamedItem(const name: DOMString): TDOMNode;
     function SetNamedItem(arg: TDOMNode): TDOMNode;
     function RemoveNamedItem(const name: DOMString): TDOMNode;
@@ -335,7 +347,7 @@ type
 // -------------------------------------------------------
 
   TDOMDocumentFragment = class(TDOMNode_WithChildren)
-  protected
+  public
     constructor Create(AOwner: TDOMDocument);
   end;
 
@@ -369,7 +381,7 @@ type
     function GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
 
     // Extensions to DOM interface:
-    constructor Create; virtual;
+    constructor Create;
     function CreateEntity(const data: DOMString): TDOMEntity;
   end;
 
@@ -394,12 +406,11 @@ type
     FSpecified: Boolean;
     AttrOwner: TDOMNamedNodeMap;
     function  GetNodeValue: DOMString; override;
-    procedure SetNodeValue(AValue: DOMString); override;
-
-    constructor Create(AOwner: TDOMDocument);
+    procedure SetNodeValue(const AValue: DOMString); override;
   public
-    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
-      overload; override;
+    constructor Create(AOwner: TDOMDocument);
+
+    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
     property Name: DOMString read FNodeName;
     property Specified: Boolean read FSpecified;
     property Value: DOMString read GetNodeValue write SetNodeValue;
@@ -411,15 +422,14 @@ type
 // -------------------------------------------------------
 
   TDOMElement = class(TDOMNode_WithChildren)
-  protected
+  private
     FAttributes: TDOMNamedNodeMap;
+  protected
     function GetAttributes: TDOMNamedNodeMap; override;
-
-    constructor Create(AOwner: TDOMDocument); virtual;
   public
+    constructor Create(AOwner: TDOMDocument);
     destructor Destroy; override;
-    function  CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
-      overload; override;
+    function  CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
     property  TagName: DOMString read FNodeName;
     function  GetAttribute(const name: DOMString): DOMString;
     procedure SetAttribute(const name, value: DOMString);
@@ -441,11 +451,9 @@ type
 // -------------------------------------------------------
 
   TDOMText = class(TDOMCharacterData)
-  protected
-    constructor Create(AOwner: TDOMDocument);
   public
-    function  CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
-      overload; override;
+    constructor Create(AOwner: TDOMDocument);
+    function  CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
     function SplitText(offset: LongWord): TDOMText;
   end;
 
@@ -455,11 +463,9 @@ type
 // -------------------------------------------------------
 
   TDOMComment = class(TDOMCharacterData)
-  protected
-    constructor Create(AOwner: TDOMDocument);
   public
-    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
-      overload; override;
+    constructor Create(AOwner: TDOMDocument);
+    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
   end;
 
 
@@ -468,11 +474,9 @@ type
 // -------------------------------------------------------
 
   TDOMCDATASection = class(TDOMText)
-  protected
-    constructor Create(AOwner: TDOMDocument);
   public
-    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
-      overload; override;
+    constructor Create(AOwner: TDOMDocument);
+    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
   end;
 
 
@@ -483,11 +487,9 @@ type
   TDOMDocumentType = class(TDOMNode)
   protected
     FEntities, FNotations: TDOMNamedNodeMap;
-
-    constructor Create(AOwner: TDOMDocument);
   public
-    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
-      overload; override;
+    constructor Create(AOwner: TDOMDocument);
+    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
     property Name: DOMString read FNodeName;
     property Entities: TDOMNamedNodeMap read FEntities;
     property Notations: TDOMNamedNodeMap read FEntities;
@@ -501,11 +503,9 @@ type
   TDOMNotation = class(TDOMNode)
   protected
     FPublicID, FSystemID: DOMString;
-
-    constructor Create(AOwner: TDOMDocument);
   public
-    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
-      overload; override;
+    constructor Create(AOwner: TDOMDocument);
+    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
     property PublicID: DOMString read FPublicID;
     property SystemID: DOMString read FSystemID;
   end;
@@ -518,9 +518,8 @@ type
   TDOMEntity = class(TDOMNode_WithChildren)
   protected
     FPublicID, FSystemID, FNotationName: DOMString;
-
-    constructor Create(AOwner: TDOMDocument);
   public
+    constructor Create(AOwner: TDOMDocument);
     property PublicID: DOMString read FPublicID;
     property SystemID: DOMString read FSystemID;
     property NotationName: DOMString read FNotationName;
@@ -532,7 +531,7 @@ type
 // -------------------------------------------------------
 
   TDOMEntityReference = class(TDOMNode_WithChildren)
-  protected
+  public
     constructor Create(AOwner: TDOMDocument);
   end;
 
@@ -542,9 +541,8 @@ type
 // -------------------------------------------------------
 
   TDOMProcessingInstruction = class(TDOMNode)
-  protected
-    constructor Create(AOwner: TDOMDocument);
   public
+    constructor Create(AOwner: TDOMDocument);
     property Target: DOMString read FNodeName;
     property Data: DOMString read FNodeValue;
   end;
@@ -659,7 +657,7 @@ begin
   Result := FNodeValue;
 end;
 
-procedure TDOMNode.SetNodeValue(AValue: DOMString);
+procedure TDOMNode.SetNodeValue(const AValue: DOMString);
 begin
   FNodeValue := AValue;
 end;
@@ -669,28 +667,47 @@ begin
   Result := TDOMNodeList.Create(Self, '*');
 end;
 
-function TDOMNode.GetFirstChild: TDOMNode; begin Result := nil end;
-function TDOMNode.GetLastChild: TDOMNode; begin Result := nil end;
-function TDOMNode.GetAttributes: TDOMNamedNodeMap; begin Result := nil end;
+function TDOMNode.GetFirstChild: TDOMNode;
+begin
+  Result := nil;
+end;
+
+function TDOMNode.GetLastChild: TDOMNode;
+begin
+  Result := nil;
+end;
+
+function TDOMNode.GetAttributes: TDOMNamedNodeMap;
+begin
+  Result := nil;
+end;
 
 function TDOMNode.InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode;
 begin
   raise EDOMHierarchyRequest.Create('Node.InsertBefore');
+  if (NewChild=nil) and (RefChild=nil) then ;
+  Result:=nil;
 end;
 
 function TDOMNode.ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode;
 begin
   raise EDOMHierarchyRequest.Create('Node.ReplaceChild');
+  if (NewChild=nil) and (OldChild=nil) then ;
+  Result:=nil;
 end;
 
 function TDOMNode.RemoveChild(OldChild: TDOMNode): TDOMNode;
 begin
   raise EDOMHierarchyRequest.Create('Node.RemoveChild');
+  if (OldChild=nil) then ;
+  Result:=nil;
 end;
 
 function TDOMNode.AppendChild(NewChild: TDOMNode): TDOMNode;
 begin
   raise EDOMHierarchyRequest.Create('Node.AppendChild');
+  if (NewChild=nil) then ;
+  Result:=nil;
 end;
 
 function TDOMNode.HasChildNodes: Boolean;
@@ -701,11 +718,14 @@ end;
 function TDOMNode.CloneNode(deep: Boolean): TDOMNode;
 begin
   Result:=CloneNode(deep, FOwnerDocument);
+  if deep then ;
 end;
 
 function TDOMNode.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
 begin
   raise EDOMNotSupported.Create('CloneNode not implemented for ' + ClassName);
+  if (deep) and (ACloneOwner=nil) then ;
+  Result:=nil;
 end;
 
 function TDOMNode.FindNode(const ANodeName: DOMString): TDOMNode;
@@ -725,6 +745,37 @@ begin
   Result := nil;
 end;
 
+//------------------------------------------------------------------------------
+
+function CompareDOMStrings(const s1, s2: DOMPChar; l1, l2: integer): integer;
+var i: integer;
+begin
+  Result:=l1-l2;
+  i:=1;
+  while (i<=l1) and (Result=0) do begin
+    Result:=ord(s1[i])-ord(s2[i]);
+    inc(i);
+  end;
+end;
+
+function CompareDOMNodeWithDOMNode(Node1, Node2: Pointer): integer;
+begin
+  Result:=CompareDOMStrings(DOMPChar(TDOMNode(Node1).NodeName),
+                            DOMPChar(TDOMNode(Node2).NodeName),
+                            length(TDOMNode(Node1).NodeName),
+                            length(TDOMNode(Node2).NodeName)
+                            );
+end;
+
+function CompareDOMStringWithDOMNode(AKey, ANode: Pointer): integer;
+begin
+  Result:=CompareDOMStrings(DOMPChar(AKey),
+                            DOMPChar(TDOMNode(ANode).NodeName),
+                            length(DOMString(AKey)),
+                            length(TDOMNode(ANode).NodeName)
+                            );
+end;
+
 
 function TDOMNode_WithChildren.GetFirstChild: TDOMNode;
 begin
@@ -740,6 +791,10 @@ destructor TDOMNode_WithChildren.Destroy;
 var
   child, next: TDOMNode;
 begin
+  if FChildNodeTree<>nil then begin
+    FChildNodeTree.Free;
+    FChildNodeTree:=nil;
+  end;
   child := FirstChild;
   while Assigned(child) do
   begin
@@ -752,8 +807,6 @@ end;
 
 function TDOMNode_WithChildren.InsertBefore(NewChild, RefChild: TDOMNode):
   TDOMNode;
-var
-  i: Integer;
 begin
   Result := NewChild;
 
@@ -783,11 +836,13 @@ begin
 
   RefChild.FPreviousSibling := NewChild;
   NewChild.FParentNode := Self;
+  AddToChildNodeTree(NewChild);
 end;
 
 function TDOMNode_WithChildren.ReplaceChild(NewChild, OldChild: TDOMNode):
   TDOMNode;
 begin
+  RemoveFromChildNodeTree(OldChild);
   InsertBefore(NewChild, OldChild);
   if Assigned(OldChild) then
     RemoveChild(OldChild);
@@ -810,7 +865,9 @@ begin
   else
     OldChild.FNextSibling.FPreviousSibling := OldChild.FPreviousSibling;
 
+  RemoveFromChildNodeTree(OldChild);
   OldChild.Free;
+  Result:=nil;
 end;
 
 function TDOMNode_WithChildren.AppendChild(NewChild: TDOMNode): TDOMNode;
@@ -843,6 +900,7 @@ begin
     FLastChild := NewChild;
     NewChild.FParentNode := Self;
   end;
+  AddToChildNodeTree(NewChild);
   Result := NewChild;
 end;
 
@@ -851,7 +909,20 @@ begin
   Result := Assigned(FFirstChild);
 end;
 
-procedure TDOMNode_WithChildren.CloneChildren(ACopy: TDOMNode; ACloneOwner: TDOMDocument);
+function TDOMNode_WithChildren.FindNode(const ANodeName: DOMString): TDOMNode;
+var AVLNode: TAVLTreeNode;
+begin
+  Result:=nil;
+  if FChildNodeTree<>nil then begin
+    AVLNode:=FChildNodeTree.FindKey(DOMPChar(ANodeName),
+                                    @CompareDOMStringWithDOMNode);
+    if AVLNode<>nil then
+      Result:=TDOMNode(AVLNode.Data);
+  end;
+end;
+
+procedure TDOMNode_WithChildren.CloneChildren(ACopy: TDOMNode;
+  ACloneOwner: TDOMDocument);
 var
   node: TDOMNode;
 begin
@@ -863,12 +934,26 @@ begin
   end;
 end;
 
+procedure TDOMNode_WithChildren.AddToChildNodeTree(NewNode: TDOMNode);
+begin
+  if FChildNodeTree=nil then
+    FChildNodeTree:=TAVLTree.Create(@CompareDOMNodeWithDOMNode);
+  if FChildNodeTree.Find(NewNode)=nil then
+    FChildNodeTree.Add(NewNode);
+end;
+
+procedure TDOMNode_WithChildren.RemoveFromChildNodeTree(OldNode: TDOMNode);
+begin
+  if FChildNodeTree<>nil then
+    FChildNodeTree.Remove(OldNode);
+end;
+
 
 // -------------------------------------------------------
 //   NodeList
 // -------------------------------------------------------
 
-constructor TDOMNodeList.Create(ANode: TDOMNode; AFilter: DOMString);
+constructor TDOMNodeList.Create(ANode: TDOMNode; const AFilter: DOMString);
 begin
   inherited Create;
   node := ANode;
@@ -1001,7 +1086,7 @@ end;
 
 function TDOMCharacterData.SubstringData(offset, count: LongWord): DOMString;
 begin
-  if (offset < 0) or (offset > Length) or (count < 0) then
+  if (offset < 0) or (longint(offset) > Length) or (count < 0) then
     raise EDOMIndexSize.Create('CharacterData.SubstringData');
   Result := Copy(FNodeValue, offset + 1, count);
 end;
@@ -1013,7 +1098,7 @@ end;
 
 procedure TDOMCharacterData.InsertData(offset: LongWord; const arg: DOMString);
 begin
-  if (offset < 0) or (offset > Length) then
+  if (offset < 0) or (longint(offset) > Length) then
     raise EDOMIndexSize.Create('CharacterData.InsertData');
 
   FNodeValue := Copy(FNodeValue, 1, offset) + arg +
@@ -1022,7 +1107,7 @@ end;
 
 procedure TDOMCharacterData.DeleteData(offset, count: LongWord);
 begin
-  if (offset < 0) or (offset > Length) or (count < 0) then
+  if (offset < 0) or (longint(offset) > Length) or (count < 0) then
     raise EDOMIndexSize.Create('CharacterData.DeleteData');
 
   FNodeValue := Copy(FNodeValue, 1, offset) +
@@ -1056,6 +1141,7 @@ function TDOMImplementation.HasFeature(const feature, version: DOMString):
   Boolean;
 begin
   Result := False;
+  if (feature='') and (version='') then ;
 end;
 
 function TDOMImplementation.CreateDocumentType(const QualifiedName, PublicID,
@@ -1063,6 +1149,8 @@ function TDOMImplementation.CreateDocumentType(const QualifiedName, PublicID,
 begin
   // !!!: Implement this method (easy to do)
   raise EDOMNotSupported.Create('DOMImplementation.CreateDocumentType');
+  if (QualifiedName='') and (PublicID='') and (SystemID='') then ;
+  Result:=nil;
 end;
 
 function TDOMImplementation.CreateDocument(const NamespaceURI,
@@ -1070,6 +1158,8 @@ function TDOMImplementation.CreateDocument(const NamespaceURI,
 begin
   // !!!: Implement this method (easy to do)
   raise EDOMNotSupported.Create('DOMImplementation.CreateDocument');
+  if (NamespaceURI='') and (QualifiedName='') and (doctype=nil) then ;
+  Result:=nil;
 end;
 
 
@@ -1129,12 +1219,16 @@ function TDOMDocument.CreateCDATASection(const data: DOMString):
   TDOMCDATASection;
 begin
   raise EDOMNotSupported.Create('DOMDocument.CreateCDATASection');
+  if data='' then ;
+  Result:=nil;
 end;
 
 function TDOMDocument.CreateProcessingInstruction(const target,
   data: DOMString): TDOMProcessingInstruction;
 begin
   raise EDOMNotSupported.Create('DOMDocument.CreateProcessingInstruction');
+  if (target='') and (data='') then ;
+  Result:=nil;
 end;
 
 function TDOMDocument.CreateAttribute(const name: DOMString): TDOMAttr;
@@ -1147,6 +1241,8 @@ function TDOMDocument.CreateEntityReference(const name: DOMString):
   TDOMEntityReference;
 begin
   raise EDOMNotSupported.Create('DOMDocument.CreateEntityReference');
+  if name='' then ;
+  Result:=nil;
 end;
 
 function TDOMDocument.CreateEntity(const data: DOMString): TDOMEntity;
@@ -1222,7 +1318,7 @@ begin
   end;
 end;
 
-procedure TDOMAttr.SetNodeValue(AValue: DOMString);
+procedure TDOMAttr.SetNodeValue(const AValue: DOMString);
 var
   tn: TDOMText;
 begin
@@ -1244,7 +1340,6 @@ constructor TDOMElement.Create(AOwner: TDOMDocument);
 begin
   FNodeType := ELEMENT_NODE;
   inherited Create(AOwner);
-  FAttributes := TDOMNamedNodeMap.Create(AOwner);
 end;
 
 destructor TDOMElement.Destroy;
@@ -1253,9 +1348,12 @@ var
 begin
   {As the attributes are _not_ childs of the element node, we have to free
    them manually here:}
-  for i := 0 to FAttributes.Count - 1 do
-    FAttributes[i].Free;
-  FAttributes.Free;
+  if FAttributes<>nil then begin
+    for i := 0 to FAttributes.Count - 1 do
+      FAttributes[i].Free;
+    FAttributes.Free;
+    FAttributes:=nil;
+  end;
   inherited Destroy;
 end;
 
@@ -1265,14 +1363,19 @@ var
 begin
   Result := TDOMElement.Create(ACloneOwner);
   Result.FNodeName := FNodeName;
-  for i := 0 to FAttributes.Count - 1 do
-    TDOMElement(Result).FAttributes.Add(FAttributes[i].CloneNode(True, ACloneOwner));
+  if FAttributes<>nil then begin
+    TDOMElement(Result).GetAttributes;
+    for i := 0 to FAttributes.Count - 1 do
+      TDOMElement(Result).FAttributes.Add(FAttributes[i].CloneNode(True, ACloneOwner));
+  end;
   if deep then
     CloneChildren(Result, ACloneOwner);
 end;
 
 function TDOMElement.GetAttributes: TDOMNamedNodeMap;
 begin
+  if FAttributes=nil then
+    FAttributes := TDOMNamedNodeMap.Create(FOwnerDocument);
   Result := FAttributes;
 end;
 
@@ -1280,12 +1383,14 @@ function TDOMElement.GetAttribute(const name: DOMString): DOMString;
 var
   i: Integer;
 begin
-  for i := 0 to FAttributes.Count - 1 do
-    if FAttributes[i].NodeName = name then
-    begin
-      Result := FAttributes[i].NodeValue;
-      exit;
-    end;
+  if FAttributes<>nil then begin
+    for i := 0 to FAttributes.Count - 1 do
+      if FAttributes[i].NodeName = name then
+      begin
+        Result := FAttributes[i].NodeValue;
+        exit;
+      end;
+  end;
   SetLength(Result, 0);
 end;
 
@@ -1294,6 +1399,7 @@ var
   i: Integer;
   attr: TDOMAttr;
 begin
+  GetAttributes;
   for i := 0 to FAttributes.Count - 1 do
     if FAttributes[i].NodeName = name then
     begin
@@ -1310,6 +1416,7 @@ procedure TDOMElement.RemoveAttribute(const name: DOMString);
 var
   i: Integer;
 begin
+  if FAttributes=nil then exit;
   for i := 0 to FAttributes.Count - 1 do
     if FAttributes[i].NodeName = name then
     begin
@@ -1323,12 +1430,14 @@ function TDOMElement.GetAttributeNode(const name: DOMString): TDOMAttr;
 var
   i: Integer;
 begin
-  for i := 0 to FAttributes.Count - 1 do
-    if FAttributes[i].NodeName = name then
-    begin
-      Result := TDOMAttr(FAttributes[i]);
-      exit;
-    end;
+  if FAttributes<>nil then begin
+    for i := 0 to FAttributes.Count - 1 do
+      if FAttributes[i].NodeName = name then
+      begin
+        Result := TDOMAttr(FAttributes[i]);
+        exit;
+      end;
+  end;
   Result := nil;
 end;
 
@@ -1336,6 +1445,7 @@ procedure TDOMElement.SetAttributeNode(NewAttr: TDOMAttr);
 var
   i: Integer;
 begin
+  if FAttributes=nil then exit;
   for i := 0 to FAttributes.Count - 1 do
     if FAttributes[i].NodeName = NewAttr.NodeName then
     begin
@@ -1350,6 +1460,8 @@ var
   i: Integer;
   node: TDOMNode;
 begin
+  Result:=nil;
+  if FAttributes=nil then exit;
   for i := 0 to FAttributes.Count - 1 do
   begin
     node := FAttributes[i];
@@ -1388,11 +1500,12 @@ function TDOMText.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
 begin
   Result := TDOMText.Create(ACloneOwner);
   Result.FNodeValue := FNodeValue;
+  if deep and (ACloneOwner=nil) then ;
 end;
 
 function TDOMText.SplitText(offset: LongWord): TDOMText;
 begin
-  if offset > Length then
+  if longint(offset) > Length then
     raise EDOMIndexSize.Create('Text.SplitText');
 
   Result := TDOMText.Create(FOwnerDocument);
@@ -1417,6 +1530,7 @@ function TDOMComment.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNo
 begin
   Result := TDOMComment.Create(ACloneOwner);
   Result.FNodeValue := FNodeValue;
+  if deep and (ACloneOwner=nil) then ;
 end;
 
 
@@ -1435,6 +1549,7 @@ function TDOMCDATASection.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): T
 begin
   Result := TDOMCDATASection.Create(ACloneOwner);
   Result.FNodeValue := FNodeValue;
+  if deep and (ACloneOwner=nil) then ;
 end;
 
 
@@ -1452,6 +1567,7 @@ function TDOMDocumentType.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): T
 begin
   Result := TDOMDocumentType.Create(ACloneOwner);
   Result.FNodeName := FNodeName;
+  if deep and (ACloneOwner=nil) then ;
 end;
 
 
@@ -1469,6 +1585,7 @@ function TDOMNotation.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMN
 begin
   Result := TDOMNotation.Create(ACloneOwner);
   Result.FNodeName := FNodeName;
+  if deep and (ACloneOwner=nil) then ;
 end;
 
 
@@ -1510,22 +1627,7 @@ end.
 
 {
   $Log$
-  Revision 1.13  2003-11-15 10:31:50  michael
-  + Fixed CloneNode overloaded call (from Andreas Hausladen)
-
-  Revision 1.12  2003/01/15 21:59:55  sg
-  * the units DOM, XMLRead and XMLWrite now compile with Delphi without
-    modifications as well
-
-  Revision 1.11  2002/12/11 21:06:07  sg
-  * Small cleanups
-  * Replaced htmldoc unit with dom_html unit
-  * Added SAX parser framework and SAX HTML parser
-
-  Revision 1.10  2002/09/07 15:15:29  peter
-    * old logs removed and tabs fixed
-
-  Revision 1.9  2002/03/01 10:02:38  sg
-  * Fixed read access method for TDOMAttr.Value
+  Revision 1.14  2004-11-05 22:32:28  peter
+    * merged xml updates from lazarus
 
 }

+ 289 - 286
fcl/xml/dom_html.pp

@@ -34,14 +34,14 @@ type
 
   THTMLCollection = class
   public
-    property Length: Cardinal;	// !!!: ro
+    property Length: Cardinal;  // !!!: ro
     function Item(Index: Cardinal): TDOMNode;
     function NamedItem(const Index: DOMString): TDOMNode;
   end;
 
   THTMLOptionsCollection = class
   public
-    property Length: Cardinal;	// !!!: ro
+    property Length: Cardinal;  // !!!: ro
     function Item(Index: Cardinal): TDOMNode;
     function NamedItem(const Index: DOMString): TDOMNode;
   end;
@@ -86,86 +86,86 @@ type
 
   THTMLLinkElement = class(THTMLElement)
   public
-    property Disabled: Boolean;	// !!!: rw
-    property Charset: DOMString;	// !!!: rw
-    property HRef: DOMString;	// !!!: rw
-    property HRefLang: DOMString;	// !!!: rw
-    property Media: DOMString;	// !!!: rw
-    property Rel: DOMString;	// !!!: rw
-    property Rev: DOMString;	// !!!: rw
-    property Target: DOMString;	// !!!: rw
-    property HTMLType: DOMString;	// !!!: rw
+    property Disabled: Boolean; // !!!: rw
+    property Charset: DOMString;        // !!!: rw
+    property HRef: DOMString;   // !!!: rw
+    property HRefLang: DOMString;       // !!!: rw
+    property Media: DOMString;  // !!!: rw
+    property Rel: DOMString;    // !!!: rw
+    property Rev: DOMString;    // !!!: rw
+    property Target: DOMString; // !!!: rw
+    property HTMLType: DOMString;       // !!!: rw
   end;
 
   THTMLTitleElement = class(THTMLElement)
   public
-    property Text: DOMString;	// !!!: rw
+    property Text: DOMString;   // !!!: rw
   end;
 
   THTMLMetaElement = class(THTMLElement)
   public
-    property Content: DOMString;	// !!!: rw
-    property HTTPEqiv: DOMString;	// !!!: rw
-    property Name: DOMString;	// !!!: rw
-    property Scheme: DOMString;	// !!!: rw
+    property Content: DOMString;        // !!!: rw
+    property HTTPEqiv: DOMString;       // !!!: rw
+    property Name: DOMString;   // !!!: rw
+    property Scheme: DOMString; // !!!: rw
   end;
 
   THTMLBaseElement = class(THTMLElement)
   public
-    property HRef: DOMString;	// !!!: rw
-    property Target: DOMString;	// !!!: rw
+    property HRef: DOMString;   // !!!: rw
+    property Target: DOMString; // !!!: rw
   end;
 
   THTMLIsIndexElement = class(THTMLElement)
   public
-    property Form: THTMLFormElement;	// !!!: ro
-    property Prompt: DOMString;	// !!!: rw
+    property Form: THTMLFormElement;    // !!!: ro
+    property Prompt: DOMString; // !!!: rw
   end;
 
   THTMLStyleElement = class(THTMLElement)
   public
-    property Disabled: Boolean;	// !!!: rw
-    property Media: DOMString;	// !!!: rw
-    property HTMLType: DOMString;	// !!!: rw
+    property Disabled: Boolean; // !!!: rw
+    property Media: DOMString;  // !!!: rw
+    property HTMLType: DOMString;       // !!!: rw
   end;
 
   THTMLBodyElement = class(THTMLElement)
   public
-    property ALink: DOMString;	// !!!: rw
-    property Background: DOMString;	// !!!: rw
-    property BgColor: DOMString;	// !!!: rw
-    property Link: DOMString;	// !!!: rw
-    property Text: DOMString;	// !!!: rw
-    property VLink: DOMString;	// !!!: rw
+    property ALink: DOMString;  // !!!: rw
+    property Background: DOMString;     // !!!: rw
+    property BgColor: DOMString;        // !!!: rw
+    property Link: DOMString;   // !!!: rw
+    property Text: DOMString;   // !!!: rw
+    property VLink: DOMString;  // !!!: rw
   end;
 
   THTMLFormElement = class(THTMLElement)
   public
-    property Elements: THTMLCollection;	// !!!: ro
-    property Length: Integer;	// !!!: ro
-    property Name: DOMString;	// !!!: rw
-    property AcceptCharset: DOMString;	// !!!: rw
-    property Action: DOMString;	// !!!: rw
-    property EncType: DOMString;	// !!!: rw
-    property Method: DOMString;	// !!!: rw
-    property Target: DOMString;	// !!!: rw
+    property Elements: THTMLCollection; // !!!: ro
+    property Length: Integer;   // !!!: ro
+    property Name: DOMString;   // !!!: rw
+    property AcceptCharset: DOMString;  // !!!: rw
+    property Action: DOMString; // !!!: rw
+    property EncType: DOMString;        // !!!: rw
+    property Method: DOMString; // !!!: rw
+    property Target: DOMString; // !!!: rw
     procedure Submit; virtual; abstract;
     procedure Reset; virtual; abstract;
   end;
 
   THTMLSelectElement = class(THTMLElement)
   public
-    property HTMLType: DOMString;	// !!!: ro
-    property SelectedIndex: Integer;	// !!!: rw
-    property Value: DOMString;	// !!!: rw
-    property Length: Cardinal;	// !!!: rw
-    property Form: THTMLFormElement;	// !!!: ro
-    property Options: THTMLOptionsCollection;	// !!!: ro
-    property Disabled: Boolean;	// !!!: rw
-    property Multiple: Boolean;	// !!!: rw
-    property Name: DOMString;	// !!!: rw
-    property Size: Integer;	// !!!: rw
-    property TabIndex: Integer;	// !!!: rw
+    property HTMLType: DOMString;       // !!!: ro
+    property SelectedIndex: Integer;    // !!!: rw
+    property Value: DOMString;  // !!!: rw
+    property Length: Cardinal;  // !!!: rw
+    property Form: THTMLFormElement;    // !!!: ro
+    property Options: THTMLOptionsCollection;   // !!!: ro
+    property Disabled: Boolean; // !!!: rw
+    property Multiple: Boolean; // !!!: rw
+    property Name: DOMString;   // !!!: rw
+    property Size: Integer;     // !!!: rw
+    property TabIndex: Integer; // !!!: rw
     procedure Add(Element, Before: THTMLElement);
     procedure Remove(Index: Integer);
     procedure Blur; virtual; abstract;
@@ -174,42 +174,42 @@ type
 
   THTMLOptGroupElement = class(THTMLElement)
   public
-    property Disabled: Boolean;	// !!!: rw
-    property GroupLabel: DOMString;	// !!!: rw
+    property Disabled: Boolean; // !!!: rw
+    property GroupLabel: DOMString;     // !!!: rw
   end;
 
   THTMLOptionElement = class(THTMLElement)
   public
-    property Form: THTMLFormElement;	// !!!: ro
-    property DefaultSelected: Boolean;	// !!!: rw
-    property Text: DOMString;	// !!!: ro
-    property Index: Integer;	// !!!: ro
-    property Disabled: Boolean;	// !!!: rw
-    property OptionLabel: DOMString;	// !!!: rw
-    property Selected: Boolean;	// !!!: rw
-    property Value: DOMString;	// !!!: rw
+    property Form: THTMLFormElement;    // !!!: ro
+    property DefaultSelected: Boolean;  // !!!: rw
+    property Text: DOMString;   // !!!: ro
+    property Index: Integer;    // !!!: ro
+    property Disabled: Boolean; // !!!: rw
+    property OptionLabel: DOMString;    // !!!: rw
+    property Selected: Boolean; // !!!: rw
+    property Value: DOMString;  // !!!: rw
   end;
 
   THTMLInputElement = class(THTMLElement)
   public
-    property DefaultValue: DOMString;	// !!!: rw
-    property DefaultChecked: Boolean;	// !!!: rw
-    property Form: THTMLFormElement;	// !!!: ro
-    property Accept: DOMString;	// !!!: rw
-    property AccessKey: DOMString;	// !!!: rw
-    property Align: DOMString;	// !!!: rw
-    property Alt: DOMString;	// !!!: rw
-    property Checked: Boolean;	// !!!: rw
-    property Disabled: Boolean;	// !!!: rw
-    property MaxLength: Integer;	// !!!: rw
-    property Name: DOMString;	// !!!: rw
-    property ReadOnly: Boolean;	// !!!: rw
-    property Size: Cardinal;	// !!!: rw
-    property Src: DOMString;	// !!!: rw
-    property TabIndex: Integer;	// !!!: rw
-    property HTMLType: DOMString;	// !!!: rw
-    property UseMap: DOMString;	// !!!: rw
-    property Value: DOMString;	// !!!: rw
+    property DefaultValue: DOMString;   // !!!: rw
+    property DefaultChecked: Boolean;   // !!!: rw
+    property Form: THTMLFormElement;    // !!!: ro
+    property Accept: DOMString; // !!!: rw
+    property AccessKey: DOMString;      // !!!: rw
+    property Align: DOMString;  // !!!: rw
+    property Alt: DOMString;    // !!!: rw
+    property Checked: Boolean;  // !!!: rw
+    property Disabled: Boolean; // !!!: rw
+    property MaxLength: Integer;        // !!!: rw
+    property Name: DOMString;   // !!!: rw
+    property ReadOnly: Boolean; // !!!: rw
+    property Size: Cardinal;    // !!!: rw
+    property Src: DOMString;    // !!!: rw
+    property TabIndex: Integer; // !!!: rw
+    property HTMLType: DOMString;       // !!!: rw
+    property UseMap: DOMString; // !!!: rw
+    property Value: DOMString;  // !!!: rw
     procedure Blur; virtual; abstract;
     procedure Focus; virtual; abstract;
     procedure Select; virtual; abstract;
@@ -218,17 +218,17 @@ type
 
   THTMLTextAreaElement = class(THTMLElement)
   public
-    property DefaultValue: DOMString;	// !!!: rw
-    property Form: THTMLFormElement;	// !!!: ro
-    property AccessKey: DOMString;	// !!!: rw
-    property Cols: Integer;	// !!!: rw
-    property Disabled: Boolean;	// !!!: rw
-    property Name: DOMString;	// !!!: rw
-    property ReadOnly: Boolean;	// !!!: rw
-    property Rows: Integer;	// !!!: rw
-    property TabIndex: Integer;	// !!!: rw
-    property HTMLType: DOMString;	// !!!: rw
-    property Value: DOMString;	// !!!: rw
+    property DefaultValue: DOMString;   // !!!: rw
+    property Form: THTMLFormElement;    // !!!: ro
+    property AccessKey: DOMString;      // !!!: rw
+    property Cols: Integer;     // !!!: rw
+    property Disabled: Boolean; // !!!: rw
+    property Name: DOMString;   // !!!: rw
+    property ReadOnly: Boolean; // !!!: rw
+    property Rows: Integer;     // !!!: rw
+    property TabIndex: Integer; // !!!: rw
+    property HTMLType: DOMString;       // !!!: rw
+    property Value: DOMString;  // !!!: rw
     procedure Blur; virtual; abstract;
     procedure Focus; virtual; abstract;
     procedure Select; virtual; abstract;
@@ -236,251 +236,251 @@ type
 
   THTMLButtonElement = class(THTMLElement)
   public
-    property Form: THTMLFormElement;	// !!!: ro
-    property AccessKey: DOMString;	// !!!: rw
-    property Disabled: Boolean;	// !!!: rw
-    property Name: DOMString;	// !!!: rw
-    property TabIndex: Integer;	// !!!: rw
-    property HTMLType: DOMString;	// !!!: rw
-    property Value: DOMString;	// !!!: rw
+    property Form: THTMLFormElement;    // !!!: ro
+    property AccessKey: DOMString;      // !!!: rw
+    property Disabled: Boolean; // !!!: rw
+    property Name: DOMString;   // !!!: rw
+    property TabIndex: Integer; // !!!: rw
+    property HTMLType: DOMString;       // !!!: rw
+    property Value: DOMString;  // !!!: rw
   end;
 
   THTMLLabelElement = class(THTMLElement)
   public
-    property Form: THTMLFormElement;	// !!!: ro
-    property AccessKey: DOMString;	// !!!: rw
-    property HtmlFor: DOMString;	// !!!: rw
+    property Form: THTMLFormElement;    // !!!: ro
+    property AccessKey: DOMString;      // !!!: rw
+    property HtmlFor: DOMString;        // !!!: rw
   end;
 
   THTMLFieldSetElement = class(THTMLElement)
   public
-    property Form: THTMLFormElement;	// !!!: ro
+    property Form: THTMLFormElement;    // !!!: ro
   end;
 
   THTMLLegendElement = class(THTMLElement)
   public
-    property Form: THTMLFormElement;	// !!!: ro
-    property AccessKey: DOMString;	// !!!: rw
-    property Align: DOMString;	// !!!: rw
+    property Form: THTMLFormElement;    // !!!: ro
+    property AccessKey: DOMString;      // !!!: rw
+    property Align: DOMString;  // !!!: rw
   end;
 
   THTMLUListElement = class(THTMLElement)
   public
-    property Compact: Boolean;	// !!!: rw
-    property HTMLType: DOMString;	// !!!: rw
+    property Compact: Boolean;  // !!!: rw
+    property HTMLType: DOMString;       // !!!: rw
   end;
 
   THTMLOListElement = class(THTMLElement)
   public
-    property Compact: Boolean;	// !!!: rw
-    property Start: Integer;	// !!!: rw
-    property HTMLType: DOMString;	// !!!: rw
+    property Compact: Boolean;  // !!!: rw
+    property Start: Integer;    // !!!: rw
+    property HTMLType: DOMString;       // !!!: rw
   end;
 
   THTMLDListElement = class(THTMLElement)
   public
-    property Compact: Boolean;	// !!!: rw
+    property Compact: Boolean;  // !!!: rw
   end;
 
   THTMLDirectoryElement = class(THTMLElement)
   public
-    property Compact: Boolean;	// !!!: rw
+    property Compact: Boolean;  // !!!: rw
   end;
 
   THTMLMenuElement = class(THTMLElement)
   public
-    property Compact: Boolean;	// !!!: rw
+    property Compact: Boolean;  // !!!: rw
   end;
 
   THTMLLIElement = class(THTMLElement)
   public
-    property HTMLType: DOMString;	// !!!: rw
-    property Value: Integer;	// !!!: rw
+    property HTMLType: DOMString;       // !!!: rw
+    property Value: Integer;    // !!!: rw
   end;
 
   THTMLDivElement = class(THTMLElement)
   public
-    property Align: DOMString;	// !!!: rw
+    property Align: DOMString;  // !!!: rw
   end;
 
   THTMLParagraphElement = class(THTMLElement)
   public
-    property Align: DOMString;	// !!!: rw
+    property Align: DOMString;  // !!!: rw
   end;
 
   THTMLHeadingElement = class(THTMLElement)
   public
-    property Align: DOMString;	// !!!: rw
+    property Align: DOMString;  // !!!: rw
   end;
 
   THTMLQuoteElement = class(THTMLElement)
   public
-    property Cite: DOMString;	// !!!: rw
+    property Cite: DOMString;   // !!!: rw
   end;
 
   THTMLPreElement = class(THTMLElement)
   public
-    property Width: Integer;	// !!!: rw
+    property Width: Integer;    // !!!: rw
   end;
 
   THTMLBREElement = class(THTMLElement)
   public
-    property Clear: DOMString;	// !!!: rw
+    property Clear: DOMString;  // !!!: rw
   end;
 
   THTMLBaseFontElement = class(THTMLElement)
   public
-    property Color: DOMString;	// !!!: rw
-    property Face: DOMString;	// !!!: rw
-    property Size: Integer;	// !!!: rw
+    property Color: DOMString;  // !!!: rw
+    property Face: DOMString;   // !!!: rw
+    property Size: Integer;     // !!!: rw
   end;
 
   THTMLFontElement = class(THTMLElement)
   public
-    property Color: DOMString;	// !!!: rw
-    property Face: DOMString;	// !!!: rw
-    property Size: Integer;	// !!!: rw
+    property Color: DOMString;  // !!!: rw
+    property Face: DOMString;   // !!!: rw
+    property Size: Integer;     // !!!: rw
   end;
 
   THTMLHRElement = class(THTMLElement)
   public
-    property Align: DOMString;	// !!!: rw
-    property NoShade: Boolean;	// !!!: rw
-    property Size: DOMString;	// !!!: rw
-    property Width: DOMString;	// !!!: rw
+    property Align: DOMString;  // !!!: rw
+    property NoShade: Boolean;  // !!!: rw
+    property Size: DOMString;   // !!!: rw
+    property Width: DOMString;  // !!!: rw
   end;
 
   THTMLModElement = class(THTMLElement)
   public
-    property Cite: DOMString;	// !!!: rw
-    property DateTime: DOMString;	// !!!: rw
+    property Cite: DOMString;   // !!!: rw
+    property DateTime: DOMString;       // !!!: rw
   end;
 
   THTMLAnchorElement = class(THTMLElement)
   public
-    property AccessKey: DOMString;	// !!!: rw
-    property Charset: DOMString;	// !!!: rw
-    property Coords: DOMString;	// !!!: rw
-    property HRef: DOMString;	// !!!: rw
-    property HRefLang: DOMString;	// !!!: rw
-    property Name: DOMString;	// !!!: rw
-    property Rel: DOMString;	// !!!: rw
-    property Rev: DOMString;	// !!!: rw
-    property Shape: DOMString;	// !!!: rw
-    property TabIndex: Integer;	// !!!: rw
-    property Target: DOMString;	// !!!: rw
-    property HTMLType: DOMString;	// !!!: rw
+    property AccessKey: DOMString;      // !!!: rw
+    property Charset: DOMString;        // !!!: rw
+    property Coords: DOMString; // !!!: rw
+    property HRef: DOMString;   // !!!: rw
+    property HRefLang: DOMString;       // !!!: rw
+    property Name: DOMString;   // !!!: rw
+    property Rel: DOMString;    // !!!: rw
+    property Rev: DOMString;    // !!!: rw
+    property Shape: DOMString;  // !!!: rw
+    property TabIndex: Integer; // !!!: rw
+    property Target: DOMString; // !!!: rw
+    property HTMLType: DOMString;       // !!!: rw
     procedure Blur; virtual; abstract;
     procedure Focus; virtual; abstract;
   end;
 
   THTMLImageElement = class(THTMLElement)
   public
-    property Name: DOMString;	// !!!: rw
-    property Align: DOMString;	// !!!: rw
-    property Alt: DOMString;	// !!!: rw
-    property Border: DOMString;	// !!!: rw
-    property Height: Integer;	// !!!: rw
-    property HSpace: Integer;	// !!!: rw
-    property IsMap: Boolean;	// !!!: rw
-    property LongDesc: DOMString;	// !!!: rw
-    property Src: Integer;	// !!!: rw
-    property UseMap: DOMString;	// !!!: rw
-    property VSpace: Integer;	// !!!: rw
-    property Width: Integer;	// !!!: rw
+    property Name: DOMString;   // !!!: rw
+    property Align: DOMString;  // !!!: rw
+    property Alt: DOMString;    // !!!: rw
+    property Border: DOMString; // !!!: rw
+    property Height: Integer;   // !!!: rw
+    property HSpace: Integer;   // !!!: rw
+    property IsMap: Boolean;    // !!!: rw
+    property LongDesc: DOMString;       // !!!: rw
+    property Src: Integer;      // !!!: rw
+    property UseMap: DOMString; // !!!: rw
+    property VSpace: Integer;   // !!!: rw
+    property Width: Integer;    // !!!: rw
   end;
 
   THTMLObjectElement = class(THTMLElement)
   public
-    property Form: THTMLFormElement;	// !!!: ro
-    property Code: DOMString;	// !!!: rw
-    property Align: DOMString;	// !!!: rw
-    property Archive: DOMString;	// !!!: rw
-    property Border: DOMString;	// !!!: rw
-    property CodeBase: DOMString;	// !!!: rw
-    property CodeType: DOMString;	// !!!: rw
-    property Data: DOMString;	// !!!: rw
-    property Declare: Boolean;	// !!!: rw
-    property Height: DOMString;	// !!!: rw
-    property HSpace: Integer;	// !!!: rw
-    property Name: DOMString;	// !!!: rw
-    property StandBy: DOMString;	// !!!: rw
-    property TabIndex: Integer;	// !!!: rw
-    property HTMLType: DOMString;	// !!!: rw
-    property UseMap: DOMString;	// !!!: rw
-    property VSpace: Integer;	// !!!: rw
-    property Width: Integer;	// !!!: rw
-    property ContentDocument: TDOMDocument;	// !!!: ro
+    property Form: THTMLFormElement;    // !!!: ro
+    property Code: DOMString;   // !!!: rw
+    property Align: DOMString;  // !!!: rw
+    property Archive: DOMString;        // !!!: rw
+    property Border: DOMString; // !!!: rw
+    property CodeBase: DOMString;       // !!!: rw
+    property CodeType: DOMString;       // !!!: rw
+    property Data: DOMString;   // !!!: rw
+    property Declare: Boolean;  // !!!: rw
+    property Height: DOMString; // !!!: rw
+    property HSpace: Integer;   // !!!: rw
+    property Name: DOMString;   // !!!: rw
+    property StandBy: DOMString;        // !!!: rw
+    property TabIndex: Integer; // !!!: rw
+    property HTMLType: DOMString;       // !!!: rw
+    property UseMap: DOMString; // !!!: rw
+    property VSpace: Integer;   // !!!: rw
+    property Width: Integer;    // !!!: rw
+    property ContentDocument: TDOMDocument;     // !!!: ro
   end;
 
   THTMLParamElement = class(THTMLElement)
   public
-    property Name: DOMString;	// !!!: rw
-    property HTMLType: DOMString;	// !!!: rw
-    property Value: DOMString;	// !!!: rw
-    property ValueType: DOMString;	// !!!: rw
+    property Name: DOMString;   // !!!: rw
+    property HTMLType: DOMString;       // !!!: rw
+    property Value: DOMString;  // !!!: rw
+    property ValueType: DOMString;      // !!!: rw
   end;
 
   THTMLAppletElement = class(THTMLElement)
   public
-    property Align: DOMString;	// !!!: rw
-    property Alt: DOMString;	// !!!: rw
-    property Archive: DOMString;	// !!!: rw
-    property Code: DOMString;	// !!!: rw
-    property CodeBase: DOMString;	// !!!: rw
-    property Height: DOMString;	// !!!: rw
-    property HSpace: Integer;	// !!!: rw
-    property Name: DOMString;	// !!!: rw
-    property AppletObject: DOMString;	// !!!: rw
-    property VSpace: Integer;	// !!!: rw
-    property Width: Integer;	// !!!: rw
+    property Align: DOMString;  // !!!: rw
+    property Alt: DOMString;    // !!!: rw
+    property Archive: DOMString;        // !!!: rw
+    property Code: DOMString;   // !!!: rw
+    property CodeBase: DOMString;       // !!!: rw
+    property Height: DOMString; // !!!: rw
+    property HSpace: Integer;   // !!!: rw
+    property Name: DOMString;   // !!!: rw
+    property AppletObject: DOMString;   // !!!: rw
+    property VSpace: Integer;   // !!!: rw
+    property Width: Integer;    // !!!: rw
   end;
 
   THTMLMapElement = class(THTMLElement)
   public
-    property Areas: THTMLCollection;	// !!!: ro
-    property Name: DOMString;	// !!!: rw
+    property Areas: THTMLCollection;    // !!!: ro
+    property Name: DOMString;   // !!!: rw
   end;
 
   THTMLAreaElement = class(THTMLElement)
   public
-    property AccessKey: DOMString;	// !!!: rw
-    property Alt: DOMString;	// !!!: rw
-    property Coords: DOMString;	// !!!: rw
-    property HRef: DOMString;	// !!!: rw
-    property NoHRef: Boolean;	// !!!: rw
-    property Shape: DOMString;	// !!!: rw
-    property TabIndex: Integer;	// !!!: rw
-    property Target: DOMString;	// !!!: rw
+    property AccessKey: DOMString;      // !!!: rw
+    property Alt: DOMString;    // !!!: rw
+    property Coords: DOMString; // !!!: rw
+    property HRef: DOMString;   // !!!: rw
+    property NoHRef: Boolean;   // !!!: rw
+    property Shape: DOMString;  // !!!: rw
+    property TabIndex: Integer; // !!!: rw
+    property Target: DOMString; // !!!: rw
   end;
 
   THTMLScriptElement = class(THTMLElement)
   public
-    property Text: DOMString;	// !!!: rw
-    property HtmlFor: DOMString;	// !!!: rw
-    property Event: DOMString;	// !!!: rw
-    property Charset: DOMString;	// !!!: rw
-    property Defer: Boolean;	// !!!: rw
-    property Src: DOMString;	// !!!: rw
-    property HTMLType: DOMString;	// !!!: rw
+    property Text: DOMString;   // !!!: rw
+    property HtmlFor: DOMString;        // !!!: rw
+    property Event: DOMString;  // !!!: rw
+    property Charset: DOMString;        // !!!: rw
+    property Defer: Boolean;    // !!!: rw
+    property Src: DOMString;    // !!!: rw
+    property HTMLType: DOMString;       // !!!: rw
   end;
 
   THTMLTableElement = class(THTMLElement)
   public
-    property Caption: THTMLTableCaptionElement;	// !!!: rw
-    property THead: THTMLTableSectionElement;	// !!!: rw
-    property TFoot: THTMLTableSectionElement;	// !!!: rw
-    property Rows: THTMLCollection;	// !!!: ro
-    property TBodies: THTMLCollection;	// !!!: ro
-    property Align: DOMString;	// !!!: rw
-    property BgColor: DOMString;	// !!!: rw
-    property Border: DOMString;	// !!!: rw
-    property CellPadding: DOMString;	// !!!: rw
-    property CellSpacing: DOMString;	// !!!: rw
-    property Frame: DOMString;	// !!!: rw
-    property Rules: DOMString;	// !!!: rw
-    property Summary: DOMString;	// !!!: rw
-    property Width: DOMString;	// !!!: rw
+    property Caption: THTMLTableCaptionElement; // !!!: rw
+    property THead: THTMLTableSectionElement;   // !!!: rw
+    property TFoot: THTMLTableSectionElement;   // !!!: rw
+    property Rows: THTMLCollection;     // !!!: ro
+    property TBodies: THTMLCollection;  // !!!: ro
+    property Align: DOMString;  // !!!: rw
+    property BgColor: DOMString;        // !!!: rw
+    property Border: DOMString; // !!!: rw
+    property CellPadding: DOMString;    // !!!: rw
+    property CellSpacing: DOMString;    // !!!: rw
+    property Frame: DOMString;  // !!!: rw
+    property Rules: DOMString;  // !!!: rw
+    property Summary: DOMString;        // !!!: rw
+    property Width: DOMString;  // !!!: rw
     function CreateTHead: THTMLElement;
     procedure DeleteTHead;
     function CreateTFoot: THTMLElement;
@@ -493,95 +493,95 @@ type
 
   THTMLTableCaptionElement = class(THTMLElement)
   public
-    property Align: DOMString;	// !!!: rw
+    property Align: DOMString;  // !!!: rw
   end;
 
   THTMLTableColElement = class(THTMLElement)
   public
-    property Align: DOMString;	// !!!: rw
-    property Ch: DOMString;	// !!!: rw
-    property ChOff: DOMString;	// !!!: rw
-    property Span: Integer;	// !!!: rw
-    property VAlign: DOMString;	// !!!: rw
-    property Width: DOMString;	// !!!: rw
+    property Align: DOMString;  // !!!: rw
+    property Ch: DOMString;     // !!!: rw
+    property ChOff: DOMString;  // !!!: rw
+    property Span: Integer;     // !!!: rw
+    property VAlign: DOMString; // !!!: rw
+    property Width: DOMString;  // !!!: rw
   end;
 
   THTMLTableSectionElement = class(THTMLElement)
   public
-    property Align: DOMString;	// !!!: rw
-    property Ch: DOMString;	// !!!: rw
-    property ChOff: DOMString;	// !!!: rw
-    property VAlign: DOMString;	// !!!: rw
-    property Rows: THTMLCollection;	// !!!: ro
+    property Align: DOMString;  // !!!: rw
+    property Ch: DOMString;     // !!!: rw
+    property ChOff: DOMString;  // !!!: rw
+    property VAlign: DOMString; // !!!: rw
+    property Rows: THTMLCollection;     // !!!: ro
     function InsertRow(Index: Integer): THTMLElement;
     procedure DeleteRow(Index: Integer);
   end;
 
   THTMLTableRowElement = class(THTMLElement)
   public
-    property RowIndex: Integer;	// !!!: ro
-    property SectionRowIndex: Integer;	// !!!: ro
-    property Cells: THTMLCollection;	// !!!: ro
-    property Align: DOMString;	// !!!: rw
-    property BgColor: DOMString;	// !!!: rw
-    property Ch: DOMString;	// !!!: rw
-    property ChOff: DOMString;	// !!!: rw
-    property VAlign: DOMString;	// !!!: rw
+    property RowIndex: Integer; // !!!: ro
+    property SectionRowIndex: Integer;  // !!!: ro
+    property Cells: THTMLCollection;    // !!!: ro
+    property Align: DOMString;  // !!!: rw
+    property BgColor: DOMString;        // !!!: rw
+    property Ch: DOMString;     // !!!: rw
+    property ChOff: DOMString;  // !!!: rw
+    property VAlign: DOMString; // !!!: rw
     function InsertCell(Index: Integer): THTMLElement;
     procedure DeleteCell(Index: Integer);
   end;
 
   THTMLTableCellElement = class(THTMLElement)
   public
-    property CellIndex: Integer;	// !!!: ro
-    property Abbr: DOMString;	// !!!: rw
-    property Align: DOMString;	// !!!: rw
-    property Axis: DOMString;	// !!!: rw
-    property BgColor: DOMString;	// !!!: rw
-    property Ch: DOMString;	// !!!: rw
-    property ChOff: DOMString;	// !!!: rw
-    property ColSpan: Integer;	// !!!: rw
-    property Headers: DOMString;	// !!!: rw
-    property Height: DOMString;	// !!!: rw
-    property NoWrap: Boolean;	// !!!: rw
-    property RowSpan: Integer;	// !!!: rw
-    property Scope: DOMString;	// !!!: rw
-    property VAlign: DOMString;	// !!!: rw
-    property Width: DOMString;	// !!!: rw
+    property CellIndex: Integer;        // !!!: ro
+    property Abbr: DOMString;   // !!!: rw
+    property Align: DOMString;  // !!!: rw
+    property Axis: DOMString;   // !!!: rw
+    property BgColor: DOMString;        // !!!: rw
+    property Ch: DOMString;     // !!!: rw
+    property ChOff: DOMString;  // !!!: rw
+    property ColSpan: Integer;  // !!!: rw
+    property Headers: DOMString;        // !!!: rw
+    property Height: DOMString; // !!!: rw
+    property NoWrap: Boolean;   // !!!: rw
+    property RowSpan: Integer;  // !!!: rw
+    property Scope: DOMString;  // !!!: rw
+    property VAlign: DOMString; // !!!: rw
+    property Width: DOMString;  // !!!: rw
   end;
 
   THTMLFrameSetElement = class(THTMLElement)
   public
-    property Cols: DOMString;	// !!!: rw
-    property Rows: DOMString;	// !!!: rw
+    property Cols: DOMString;   // !!!: rw
+    property Rows: DOMString;   // !!!: rw
   end;
 
   THTMLFrameElement = class(THTMLElement)
   public
-    property FrameBorder: DOMString;	// !!!: rw
-    property LongDesc: DOMString;	// !!!: rw
-    property MarginHeight: DOMString;	// !!!: rw
-    property MarginWidth: DOMString;	// !!!: rw
-    property Name: DOMString;	// !!!: rw
-    property NoResize: Boolean;	// !!!: rw
-    property Scrolling: DOMString;	// !!!: rw
-    property Src: DOMString;	// !!!: rw
-    property ContentDocument: TDOMDocument;	// !!!: ro
+    property FrameBorder: DOMString;    // !!!: rw
+    property LongDesc: DOMString;       // !!!: rw
+    property MarginHeight: DOMString;   // !!!: rw
+    property MarginWidth: DOMString;    // !!!: rw
+    property Name: DOMString;   // !!!: rw
+    property NoResize: Boolean; // !!!: rw
+    property Scrolling: DOMString;      // !!!: rw
+    property Src: DOMString;    // !!!: rw
+    property ContentDocument: TDOMDocument;     // !!!: ro
   end;
 
   THTMLIFrameElement = class(THTMLElement)
   public
-    property Align: DOMString;	// !!!: rw
-    property FrameBorder: DOMString;	// !!!: rw
-    property Height: DOMString;	// !!!: rw
-    property LongDesc: DOMString;	// !!!: rw
-    property MarginHeight: DOMString;	// !!!: rw
-    property MarginWidth: DOMString;	// !!!: rw
-    property Name: DOMString;	// !!!: rw
-    property Scrolling: DOMString;	// !!!: rw
-    property Src: DOMString;	// !!!: rw
-    property Width: DOMString;	// !!!: rw
-    property ContentDocument: TDOMDocument;	// !!!: ro
+    property Align: DOMString;  // !!!: rw
+    property FrameBorder: DOMString;    // !!!: rw
+    property Height: DOMString; // !!!: rw
+    property LongDesc: DOMString;       // !!!: rw
+    property MarginHeight: DOMString;   // !!!: rw
+    property MarginWidth: DOMString;    // !!!: rw
+    property Name: DOMString;   // !!!: rw
+    property Scrolling: DOMString;      // !!!: rw
+    property Src: DOMString;    // !!!: rw
+    property Width: DOMString;  // !!!: rw
+    property ContentDocument: TDOMDocument;     // !!!: ro
   end;
 
   THTMLDocument = class(TXMLDocument)
@@ -590,16 +590,16 @@ type
     procedure SetTitle(const Value: DOMString);
   public
     property Title: DOMString read GetTitle write SetTitle;
-    property Referrer: DOMString;	// !!!: ro
-    property Domain: DOMString;	// !!!: ro
-    property URL: DOMString;	// !!!: ro
-    property Body: THTMLElement;	// !!!: rw
-    property Images: THTMLCollection;	// !!!: ro
-    property Applets: THTMLCollection;	// !!!: ro
-    property Links: THTMLCollection;	// !!!: ro
-    property Forms: THTMLCollection;	// !!!: ro
-    property Anchors: THTMLCollection;	// !!!: ro
-    property Cookie: DOMString;		// !!!: rw
+    property Referrer: DOMString;       // !!!: ro
+    property Domain: DOMString; // !!!: ro
+    property URL: DOMString;    // !!!: ro
+    property Body: THTMLElement;        // !!!: rw
+    property Images: THTMLCollection;   // !!!: ro
+    property Applets: THTMLCollection;  // !!!: ro
+    property Links: THTMLCollection;    // !!!: ro
+    property Forms: THTMLCollection;    // !!!: ro
+    property Anchors: THTMLCollection;  // !!!: ro
+    property Cookie: DOMString;         // !!!: rw
 
     procedure Open; virtual; abstract;
     procedure Close; virtual; abstract;
@@ -924,7 +924,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-12-11 21:06:07  sg
+  Revision 1.2  2004-11-05 22:32:28  peter
+    * merged xml updates from lazarus
+
+  Revision 1.1  2002/12/11 21:06:07  sg
   * Small cleanups
   * Replaced htmldoc unit with dom_html unit
   * Added SAX parser framework and SAX HTML parser

+ 229 - 226
fcl/xml/htmldefs.pp

@@ -26,9 +26,9 @@ interface
 type
 
   THTMLElementFlags = set of (
-    efSubelementContent,		// may have subelements
-    efPCDATAContent,			// may have PCDATA content
-    efPreserveWhitespace);		// preserve all whitespace
+    efSubelementContent,                // may have subelements
+    efPCDATAContent,                    // may have PCDATA content
+    efPreserveWhitespace);              // preserve all whitespace
 
   PHTMLElementProps = ^THTMLElementProps;
   THTMLElementProps = record
@@ -40,85 +40,85 @@ type
 const
 
   HTMLElProps: array[0..78] of THTMLElementProps = (
-    (Name: 'a';		Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'abbr';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'acronym';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'address';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'applet';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'b';		Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'basefont';	Flags: []),
-    (Name: 'bdo';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'big';	Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'a';         Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'abbr';      Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'acronym';   Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'address';   Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'applet';    Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'b';         Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'basefont';  Flags: []),
+    (Name: 'bdo';       Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'big';       Flags: [efSubelementContent, efPCDATAContent]),
     (Name: 'blockquote';Flags: [efSubelementContent]),
-    (Name: 'body';	Flags: [efSubelementContent]),
-    (Name: 'br';	Flags: []),
-    (Name: 'button';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'caption';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'center';	Flags: [efSubelementContent]),
-    (Name: 'cite';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'code';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'col';	Flags: []),
-    (Name: 'colgroup';	Flags: [efSubelementContent]),
-    (Name: 'del';	Flags: [efSubelementContent]),
-    (Name: 'dfn';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'dir';	Flags: [efSubelementContent]),
-    (Name: 'div';	Flags: [efSubelementContent]),
-    (Name: 'dl';	Flags: [efSubelementContent]),
-    (Name: 'em';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'fieldset';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'font';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'form';	Flags: [efSubelementContent]),
-    (Name: 'h1';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'h2';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'h3';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'h4';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'h5';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'h6';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'head';	Flags: [efSubelementContent]),
-    (Name: 'hr';	Flags: []),
-    (Name: 'html';	Flags: [efSubelementContent]),
-    (Name: 'i';		Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'iframe';	Flags: [efSubelementContent]),
-    (Name: 'img';	Flags: []),
-    (Name: 'input';	Flags: []),
-    (Name: 'ins';	Flags: [efSubelementContent]),
-    (Name: 'isindex';	Flags: []),
-    (Name: 'kbd';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'label';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'link';	Flags: []),
-    (Name: 'map';	Flags: [efSubelementContent]),
-    (Name: 'menu';	Flags: [efSubelementContent]),
-    (Name: 'meta';	Flags: []),
-    (Name: 'noframes';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'noscript';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'object';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'ol';	Flags: [efSubelementContent]),
-    (Name: 'p';		Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'pre';	Flags: [efSubelementContent, efPCDATAContent, efPreserveWhitespace]),
-    (Name: 'q';		Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 's';		Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'samp';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'script';	Flags: [efPCDATAContent]),
-    (Name: 'select';	Flags: [efSubelementContent]),
-    (Name: 'small';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'span';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'strike';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'strong';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'style';	Flags: [efPCDATAContent]),
-    (Name: 'sub';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'sup';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'table';	Flags: [efSubelementContent]),
-    (Name: 'textarea';	Flags: [efPCDATAContent]),
-    (Name: 'tbody';	Flags: [efSubelementContent]),
-    (Name: 'td';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'tfoot';	Flags: [efSubelementContent]),
-    (Name: 'th';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'thead';	Flags: [efSubelementContent]),
-    (Name: 'tr';	Flags: [efSubelementContent]),
-    (Name: 'tt';	Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'u';		Flags: [efSubelementContent, efPCDATAContent]),
-    (Name: 'ul';	Flags: [efSubelementContent]),
-    (Name: 'var';	Flags: [efSubelementContent, efPCDATAContent]));
+    (Name: 'body';      Flags: [efSubelementContent]),
+    (Name: 'br';        Flags: []),
+    (Name: 'button';    Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'caption';   Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'center';    Flags: [efSubelementContent]),
+    (Name: 'cite';      Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'code';      Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'col';       Flags: []),
+    (Name: 'colgroup';  Flags: [efSubelementContent]),
+    (Name: 'del';       Flags: [efSubelementContent]),
+    (Name: 'dfn';       Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'dir';       Flags: [efSubelementContent]),
+    (Name: 'div';       Flags: [efSubelementContent]),
+    (Name: 'dl';        Flags: [efSubelementContent]),
+    (Name: 'em';        Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'fieldset';  Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'font';      Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'form';      Flags: [efSubelementContent]),
+    (Name: 'h1';        Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'h2';        Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'h3';        Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'h4';        Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'h5';        Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'h6';        Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'head';      Flags: [efSubelementContent]),
+    (Name: 'hr';        Flags: []),
+    (Name: 'html';      Flags: [efSubelementContent]),
+    (Name: 'i';         Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'iframe';    Flags: [efSubelementContent]),
+    (Name: 'img';       Flags: []),
+    (Name: 'input';     Flags: []),
+    (Name: 'ins';       Flags: [efSubelementContent]),
+    (Name: 'isindex';   Flags: []),
+    (Name: 'kbd';       Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'label';     Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'link';      Flags: []),
+    (Name: 'map';       Flags: [efSubelementContent]),
+    (Name: 'menu';      Flags: [efSubelementContent]),
+    (Name: 'meta';      Flags: []),
+    (Name: 'noframes';  Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'noscript';  Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'object';    Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'ol';        Flags: [efSubelementContent]),
+    (Name: 'p';         Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'pre';       Flags: [efSubelementContent, efPCDATAContent, efPreserveWhitespace]),
+    (Name: 'q';         Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 's';         Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'samp';      Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'script';    Flags: [efPCDATAContent]),
+    (Name: 'select';    Flags: [efSubelementContent]),
+    (Name: 'small';     Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'span';      Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'strike';    Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'strong';    Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'style';     Flags: [efPCDATAContent]),
+    (Name: 'sub';       Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'sup';       Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'table';     Flags: [efSubelementContent]),
+    (Name: 'textarea';  Flags: [efPCDATAContent]),
+    (Name: 'tbody';     Flags: [efSubelementContent]),
+    (Name: 'td';        Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'tfoot';     Flags: [efSubelementContent]),
+    (Name: 'th';        Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'thead';     Flags: [efSubelementContent]),
+    (Name: 'tr';        Flags: [efSubelementContent]),
+    (Name: 'tt';        Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'u';         Flags: [efSubelementContent, efPCDATAContent]),
+    (Name: 'ul';        Flags: [efSubelementContent]),
+    (Name: 'var';       Flags: [efSubelementContent, efPCDATAContent]));
 
 
   // ISO8859-1 mapping:
@@ -141,148 +141,148 @@ const
 
 
   UnicodeHTMLEntities: array[0..141] of String = (
-    'Alpha',	// #913
-    'Beta',	// #914
-    'Gamma',	// #915
-    'Delta',	// #916
-    'Epsilon',	// #917
-    'Zeta',	// #918
-    'Eta',	// #919
-    'Theta',	// #920
-    'Iota',	// #921
-    'Kappa',	// #922
-    'Lambda',	// #923
-    'Mu',	// #924
-    'Nu',	// #925
-    'Xi',	// #926
-    'Omicron',	// #927
-    'Pi',	// #928
-    'Rho',	// #929
-    'Sigma',	// #931
-    'Tau',	// #932
-    'Upsilon',	// #933
-    'Phi',	// #934
-    'Chi',	// #935
-    'Psi',	// #936
-    'Omega',	// #937
-    'alpha',	// #945
-    'beta',	// #946
-    'gamma',	// #947
-    'delta',	// #948
-    'epsilon',	// #949
-    'zeta',	// #950
-    'eta',	// #951
-    'theta',	// #952
-    'iota',	// #953
-    'kappa',	// #954
-    'lambda',	// #955
-    'mu',	// #956
-    'nu',	// #957
-    'xi',	// #958
-    'omicron',	// #959
-    'pi',	// #960
-    'rho',	// #961
-    'sigmaf',	// #962
-    'sigma',	// #963
-    'tau',	// #964
-    'upsilon',	// #965
-    'phi',	// #966
-    'chi',	// #967
-    'psi',	// #968
-    'omega',	// #969
-    'thetasym',	// #977
-    'upsih',	// #978
-    'piv',	// #982
-    'ensp',	// #8194
-    'emsp',	// #8195
-    'thinsp',	// #8201
-    'zwnj',	// #8204
-    'zwj',	// #8205
-    'lrm',	// #8206
-    'rlm',	// #8207
-    'ndash',	// #8211
-    'mdash',	// #8212
-    'lsquo',	// #8216
-    'rsquo',	// #8217
-    'sbquo',	// #8218
-    'ldquo',	// #8220
-    'rdquo',	// #8221
-    'bdquo',	// #8222
-    'dagger',	// #8224
-    'Dagger',	// #8225
-    'bull',	// #8226
-    'hellip',	// #8230
-    'permil',	// #8240
-    'prime',	// #8242
-    'lsaquo',	// #8249
-    'rsaquo',	// #8250
-    'oline',	// #8254
-    'frasl',	// #8260
-    'image',	// #8465
-    'weierp',	// #8472
-    'real',	// #8476
-    'trade',	// #8482
-    'alefsym',	// #8501
-    'larr',	// #8592
-    'uarr',	// #8593
-    'rarr',	// #8594
-    'darr',	// #8595
-    'harr',	// #8596
-    'crarr',	// #8629
-    'lArr',	// #8656
-    'uArr',	// #8657
-    'rArr',	// #8658
-    'dArr',	// #8659
-    'hArr',	// #8660
-    'forall',	// #8704
-    'part',	// #8706
-    'exist',	// #8707
-    'empty',	// #8709
-    'nabla',	// #8711
-    'isin',	// #8712
-    'notin',	// #8713
-    'ni',	// #8715
-    'prod',	// #8719
-    'sum',	// #8721
-    'minus',	// #8722
-    'lowast',	// #8727
-    'radic',	// #8730
-    'prop',	// #8733
-    'infin',	// #8734
-    'ang',	// #8736
-    'and',	// #8743
-    'or',	// #8744
-    'cap',	// #8745
-    'cup',	// #8746
-    'int',	// #8747
-    'there4',	// #8756
-    'sim',	// #8764
-    'cong',	// #8773
-    'asymp',	// #8776
-    'ne',	// #8800
-    'equiv',	// #8801
-    'le',	// #8804
-    'ge',	// #8805
-    'sub',	// #8834
-    'sup',	// #8835
-    'nsub',	// #8836
-    'sube',	// #8838
-    'supe',	// #8839
-    'oplus',	// #8853
-    'otimes',	// #8855
-    'perp',	// #8869
-    'sdot',	// #8901
-    'lceil',	// #8968
-    'rceil',	// #8969
-    'lfloor',	// #8970
-    'rfloor',	// #8971
-    'lang',	// #9001
-    'rang',	// #9002
-    'loz',	// #9674
-    'spades',	// #9824
-    'clubs',	// #9827
-    'hearts',	// #9829
-    'diams'	// #9830
+    'Alpha',    // #913
+    'Beta',     // #914
+    'Gamma',    // #915
+    'Delta',    // #916
+    'Epsilon',  // #917
+    'Zeta',     // #918
+    'Eta',      // #919
+    'Theta',    // #920
+    'Iota',     // #921
+    'Kappa',    // #922
+    'Lambda',   // #923
+    'Mu',       // #924
+    'Nu',       // #925
+    'Xi',       // #926
+    'Omicron',  // #927
+    'Pi',       // #928
+    'Rho',      // #929
+    'Sigma',    // #931
+    'Tau',      // #932
+    'Upsilon',  // #933
+    'Phi',      // #934
+    'Chi',      // #935
+    'Psi',      // #936
+    'Omega',    // #937
+    'alpha',    // #945
+    'beta',     // #946
+    'gamma',    // #947
+    'delta',    // #948
+    'epsilon',  // #949
+    'zeta',     // #950
+    'eta',      // #951
+    'theta',    // #952
+    'iota',     // #953
+    'kappa',    // #954
+    'lambda',   // #955
+    'mu',       // #956
+    'nu',       // #957
+    'xi',       // #958
+    'omicron',  // #959
+    'pi',       // #960
+    'rho',      // #961
+    'sigmaf',   // #962
+    'sigma',    // #963
+    'tau',      // #964
+    'upsilon',  // #965
+    'phi',      // #966
+    'chi',      // #967
+    'psi',      // #968
+    'omega',    // #969
+    'thetasym', // #977
+    'upsih',    // #978
+    'piv',      // #982
+    'ensp',     // #8194
+    'emsp',     // #8195
+    'thinsp',   // #8201
+    'zwnj',     // #8204
+    'zwj',      // #8205
+    'lrm',      // #8206
+    'rlm',      // #8207
+    'ndash',    // #8211
+    'mdash',    // #8212
+    'lsquo',    // #8216
+    'rsquo',    // #8217
+    'sbquo',    // #8218
+    'ldquo',    // #8220
+    'rdquo',    // #8221
+    'bdquo',    // #8222
+    'dagger',   // #8224
+    'Dagger',   // #8225
+    'bull',     // #8226
+    'hellip',   // #8230
+    'permil',   // #8240
+    'prime',    // #8242
+    'lsaquo',   // #8249
+    'rsaquo',   // #8250
+    'oline',    // #8254
+    'frasl',    // #8260
+    'image',    // #8465
+    'weierp',   // #8472
+    'real',     // #8476
+    'trade',    // #8482
+    'alefsym',  // #8501
+    'larr',     // #8592
+    'uarr',     // #8593
+    'rarr',     // #8594
+    'darr',     // #8595
+    'harr',     // #8596
+    'crarr',    // #8629
+    'lArr',     // #8656
+    'uArr',     // #8657
+    'rArr',     // #8658
+    'dArr',     // #8659
+    'hArr',     // #8660
+    'forall',   // #8704
+    'part',     // #8706
+    'exist',    // #8707
+    'empty',    // #8709
+    'nabla',    // #8711
+    'isin',     // #8712
+    'notin',    // #8713
+    'ni',       // #8715
+    'prod',     // #8719
+    'sum',      // #8721
+    'minus',    // #8722
+    'lowast',   // #8727
+    'radic',    // #8730
+    'prop',     // #8733
+    'infin',    // #8734
+    'ang',      // #8736
+    'and',      // #8743
+    'or',       // #8744
+    'cap',      // #8745
+    'cup',      // #8746
+    'int',      // #8747
+    'there4',   // #8756
+    'sim',      // #8764
+    'cong',     // #8773
+    'asymp',    // #8776
+    'ne',       // #8800
+    'equiv',    // #8801
+    'le',       // #8804
+    'ge',       // #8805
+    'sub',      // #8834
+    'sup',      // #8835
+    'nsub',     // #8836
+    'sube',     // #8838
+    'supe',     // #8839
+    'oplus',    // #8853
+    'otimes',   // #8855
+    'perp',     // #8869
+    'sdot',     // #8901
+    'lceil',    // #8968
+    'rceil',    // #8969
+    'lfloor',   // #8970
+    'rfloor',   // #8971
+    'lang',     // #9001
+    'rang',     // #9002
+    'loz',      // #9674
+    'spades',   // #9824
+    'clubs',    // #9827
+    'hearts',   // #9829
+    'diams'     // #9830
   );
 
 
@@ -339,8 +339,8 @@ begin
       if HTMLEntities[Ent] = Name then
       begin
         Entity := Ent;
-	Result := True;
-	exit;
+        Result := True;
+        exit;
       end;
     Result := False;
   end;
@@ -351,7 +351,10 @@ end.
 
 {
   $Log$
-  Revision 1.2  2003-03-16 22:32:44  sg
+  Revision 1.3  2004-11-05 22:32:28  peter
+    * merged xml updates from lazarus
+
+  Revision 1.2  2003/03/16 22:32:44  sg
   * Fixed td and th attributes
 
   Revision 1.1  2002/11/29 18:04:25  sg

+ 5 - 2
fcl/xml/htmwrite.pp

@@ -186,7 +186,7 @@ var
   ElFlags: THTMLElementFlags;
 begin
   s := LowerCase(node.NodeName);
-  ElFlags := [efSubelementContent, efPCDATAContent];	// default flags
+  ElFlags := [efSubelementContent, efPCDATAContent];    // default flags
   for i := Low(HTMLElProps) to High(HTMLElProps) do
     if HTMLElProps[i].Name = s then
     begin
@@ -381,7 +381,10 @@ end.
 
 {
   $Log$
-  Revision 1.5  2002-11-29 18:04:25  sg
+  Revision 1.6  2004-11-05 22:32:28  peter
+    * merged xml updates from lazarus
+
+  Revision 1.5  2002/11/29 18:04:25  sg
   * Improved HTML writing, now uses the HTML definition unit
     (moved from FPDoc into FCL)
 

+ 195 - 192
fcl/xml/sax_html.pp

@@ -38,10 +38,10 @@ type
 
   THTMLScannerContext = (
     scUnknown,
-    scWhitespace,	// within whitespace
-    scText,		// within text
-    scEntityReference,	// within entity reference ("&...;")
-    scTag);		// within a start tag or end tag
+    scWhitespace,       // within whitespace
+    scText,             // within text
+    scEntityReference,  // within entity reference ("&...;")
+    scTag);             // within a start tag or end tag
 
   THTMLReader = class(TSAXReader)
   private
@@ -159,110 +159,110 @@ begin
     while BufferPos < BufferSize do
       case ScannerContext of
         scUnknown:
-	  case Buffer[BufferPos] of
-	    #9, #10, #13, ' ':
-	      EnterNewScannerContext(scWhitespace);
-	    '&':
-	      begin
-	        Inc(BufferPos);
-	        EnterNewScannerContext(scEntityReference);
-	      end;
-	    '<':
-	      begin
-	        Inc(BufferPos);
-	        EnterNewScannerContext(scTag);
-	      end;
-	    else
-	      EnterNewScannerContext(scText);
-	  end;
-	scWhitespace:
-	  case Buffer[BufferPos] of
-	    #9, #10, #13, ' ':
-	      begin
-		FTokenText := FTokenText + Buffer[BufferPos];
-	        Inc(BufferPos);
-	      end;
-	    '&':
-	      begin
-	        Inc(BufferPos);
-	        EnterNewScannerContext(scEntityReference);
-	      end;
-	    '<':
-	      begin
-	        Inc(BufferPos);
-		EnterNewScannerContext(scTag);
-	      end;
-	    else
-	      EnterNewScannerContext(scText);
-	  end;
+          case Buffer[BufferPos] of
+            #9, #10, #13, ' ':
+              EnterNewScannerContext(scWhitespace);
+            '&':
+              begin
+                Inc(BufferPos);
+                EnterNewScannerContext(scEntityReference);
+              end;
+            '<':
+              begin
+                Inc(BufferPos);
+                EnterNewScannerContext(scTag);
+              end;
+            else
+              EnterNewScannerContext(scText);
+          end;
+        scWhitespace:
+          case Buffer[BufferPos] of
+            #9, #10, #13, ' ':
+              begin
+                FTokenText := FTokenText + Buffer[BufferPos];
+                Inc(BufferPos);
+              end;
+            '&':
+              begin
+                Inc(BufferPos);
+                EnterNewScannerContext(scEntityReference);
+              end;
+            '<':
+              begin
+                Inc(BufferPos);
+                EnterNewScannerContext(scTag);
+              end;
+            else
+              EnterNewScannerContext(scText);
+          end;
         scText:
-	  case Buffer[BufferPos] of
-	    #9, #10, #13, ' ':
-	      EnterNewScannerContext(scWhitespace);
-	    '&':
-	      begin
-	        Inc(BufferPos);
-	        EnterNewScannerContext(scEntityReference);
-	      end;
-	    '<':
-	      begin
-	        Inc(BufferPos);
-		EnterNewScannerContext(scTag);
-	      end;
-	    else
-	    begin
-	      FTokenText := FTokenText + Buffer[BufferPos];
-	      Inc(BufferPos);
-	    end;
-	  end;
-	scEntityReference:
-	  if Buffer[BufferPos] = ';' then
-	  begin
-	    Inc(BufferPos);
-	    EnterNewScannerContext(scUnknown);
-	  end else if not (Buffer[BufferPos] in
-	    ['a'..'z', 'A'..'Z', '0'..'9', '#']) then
-	    EnterNewScannerContext(scUnknown)
-	  else
-	  begin
-	    FTokenText := FTokenText + Buffer[BufferPos];
-	    Inc(BufferPos);
-	  end;
-	scTag:
-	  case Buffer[BufferPos] of
-	    '''', '"':
-	      begin
-	        if FAttrNameRead then
-		begin
-	          if FCurStringValueDelimiter = #0 then
-		    FCurStringValueDelimiter := Buffer[BufferPos]
-		  else if FCurStringValueDelimiter = Buffer[BufferPos] then
-		  begin
-		    FCurStringValueDelimiter := #0;
-		    FAttrNameRead := False;
-		  end;
-		end;
-		FTokenText := FTokenText + Buffer[BufferPos];
-		Inc(BufferPos);
-	      end;
-	    '=':
-	      begin
-	        FAttrNameRead := True;
-		FTokenText := FTokenText + Buffer[BufferPos];
-		Inc(BufferPos);
-	      end;
-	    '>':
-	      begin
-	        Inc(BufferPos);
-		if FCurStringValueDelimiter = #0 then
-		  EnterNewScannerContext(scUnknown);
-	      end;
-	    else
-	    begin
-	      FTokenText := FTokenText + Buffer[BufferPos];
-	      Inc(BufferPos);
-	    end;
-	  end;
+          case Buffer[BufferPos] of
+            #9, #10, #13, ' ':
+              EnterNewScannerContext(scWhitespace);
+            '&':
+              begin
+                Inc(BufferPos);
+                EnterNewScannerContext(scEntityReference);
+              end;
+            '<':
+              begin
+                Inc(BufferPos);
+                EnterNewScannerContext(scTag);
+              end;
+            else
+            begin
+              FTokenText := FTokenText + Buffer[BufferPos];
+              Inc(BufferPos);
+            end;
+          end;
+        scEntityReference:
+          if Buffer[BufferPos] = ';' then
+          begin
+            Inc(BufferPos);
+            EnterNewScannerContext(scUnknown);
+          end else if not (Buffer[BufferPos] in
+            ['a'..'z', 'A'..'Z', '0'..'9', '#']) then
+            EnterNewScannerContext(scUnknown)
+          else
+          begin
+            FTokenText := FTokenText + Buffer[BufferPos];
+            Inc(BufferPos);
+          end;
+        scTag:
+          case Buffer[BufferPos] of
+            '''', '"':
+              begin
+                if FAttrNameRead then
+                begin
+                  if FCurStringValueDelimiter = #0 then
+                    FCurStringValueDelimiter := Buffer[BufferPos]
+                  else if FCurStringValueDelimiter = Buffer[BufferPos] then
+                  begin
+                    FCurStringValueDelimiter := #0;
+                    FAttrNameRead := False;
+                  end;
+                end;
+                FTokenText := FTokenText + Buffer[BufferPos];
+                Inc(BufferPos);
+              end;
+            '=':
+              begin
+                FAttrNameRead := True;
+                FTokenText := FTokenText + Buffer[BufferPos];
+                Inc(BufferPos);
+              end;
+            '>':
+              begin
+                Inc(BufferPos);
+                if FCurStringValueDelimiter = #0 then
+                  EnterNewScannerContext(scUnknown);
+              end;
+            else
+            begin
+              FTokenText := FTokenText + Buffer[BufferPos];
+              Inc(BufferPos);
+            end;
+          end;
       end;
   end;
 end;
@@ -295,48 +295,48 @@ procedure THTMLReader.EnterNewScannerContext(NewContext: THTMLScannerContext);
 
       while j <= Length(s) do
         if s[j] = '=' then
-	begin
-	  AttrName := LowerCase(Copy(s, i, j - i));
-	  Inc(j);
-	  if (j < Length(s)) and ((s[j] = '''') or (s[j] = '"')) then
-	  begin
-  	    ValueDelimiter := s[j];
-	    Inc(j);
-	  end else
-	    ValueDelimiter := #0;
-	  i := j;
-	  DoIncJ := False;
-	  while j <= Length(s) do
-	    if ValueDelimiter = #0 then
-	      if s[j] in WhitespaceChars then
-	        break
-	      else
-	        Inc(j)
-	    else if s[j] = ValueDelimiter then
-	    begin
-	      DoIncJ := True;
-	      break
-	    end else
-	      Inc(j);
+        begin
+          AttrName := LowerCase(Copy(s, i, j - i));
+          Inc(j);
+          if (j < Length(s)) and ((s[j] = '''') or (s[j] = '"')) then
+          begin
+            ValueDelimiter := s[j];
+            Inc(j);
+          end else
+            ValueDelimiter := #0;
+          i := j;
+          DoIncJ := False;
+          while j <= Length(s) do
+            if ValueDelimiter = #0 then
+              if s[j] in WhitespaceChars then
+                break
+              else
+                Inc(j)
+            else if s[j] = ValueDelimiter then
+            begin
+              DoIncJ := True;
+              break
+            end else
+              Inc(j);
 
           Attr.AddAttribute('', AttrName, '', '', Copy(s, i, j - i));
 
-	  if DoIncJ then
-	    Inc(j);
+          if DoIncJ then
+            Inc(j);
 
           while (j <= Length(s)) and (s[j] in WhitespaceChars) do
-	    Inc(j);
-	  i := j;
-	end
-	else if s[j] in WhitespaceChars then
-	begin
-	  Attr.AddAttribute('', Copy(s, i, j - i), '', '', '');
-	  Inc(j);
+            Inc(j);
+          i := j;
+        end
+        else if s[j] in WhitespaceChars then
+        begin
+          Attr.AddAttribute('', Copy(s, i, j - i), '', '', '');
+          Inc(j);
           while (j <= Length(s)) and (s[j] in WhitespaceChars) do
-	    Inc(j);
-	  i := j;
+            Inc(j);
+          i := j;
         end else
-	  Inc(j);
+          Inc(j);
     end;
   end;
 
@@ -355,43 +355,43 @@ begin
     scEntityReference:
       begin
         if ResolveHTMLEntityReference(TokenText, Ent) then
-	begin
-	  EntString := Ent;
-	  DoCharacters(PSAXChar(EntString), 0, 1);
-	end else
-	begin
-	  { Is this a predefined Unicode character entity? We must check this,
-	    as undefined entities must be handled as text, for compatiblity
-	    to popular browsers... }
-	  Found := False;
-	  for i := Low(UnicodeHTMLEntities) to High(UnicodeHTMLEntities) do
-	    if UnicodeHTMLEntities[i] = TokenText then
-	    begin
-	      Found := True;
-	      break;
-	    end;
-	  if Found then
-	    DoSkippedEntity(TokenText)
-	  else
+        begin
+          EntString := Ent;
+          DoCharacters(PSAXChar(EntString), 0, 1);
+        end else
+        begin
+          { Is this a predefined Unicode character entity? We must check this,
+            as undefined entities must be handled as text, for compatiblity
+            to popular browsers... }
+          Found := False;
+          for i := Low(UnicodeHTMLEntities) to High(UnicodeHTMLEntities) do
+            if UnicodeHTMLEntities[i] = TokenText then
+            begin
+              Found := True;
+              break;
+            end;
+          if Found then
+            DoSkippedEntity(TokenText)
+          else
             DoCharacters(PSAXChar('&' + TokenText), 0, Length(TokenText) + 1);
-	end;
+        end;
       end;
     scTag:
       if Length(TokenText) > 0 then
       begin
         Attr := nil;
         if TokenText[1] = '/' then
-	begin
-	  DoEndElement('',
-	    SplitTagString(Copy(TokenText, 2, Length(TokenText)), Attr), '');
-	end else if TokenText[1] <> '!' then
-	begin
-	  // Do NOT combine to a single line, as Attr is an output value!
-	  TagName := SplitTagString(TokenText, Attr);
-	  DoStartElement('', TagName, '', Attr);
-	end;
-	if Assigned(Attr) then
-  	  Attr.Free;
+        begin
+          DoEndElement('',
+            SplitTagString(Copy(TokenText, 2, Length(TokenText)), Attr), '');
+        end else if TokenText[1] <> '!' then
+        begin
+          // Do NOT combine to a single line, as Attr is an output value!
+          TagName := SplitTagString(TokenText, Attr);
+          DoStartElement('', TagName, '', Attr);
+        end;
+        if Assigned(Attr) then
+          Attr.Free;
       end;
   end;
   FScannerContext := NewContext;
@@ -546,33 +546,33 @@ begin
       TagInfo := nil;
       for j := Low(HTMLElProps) to High(HTMLElProps) do
         if CompareText(HTMLElProps[j].Name, LocalName) = 0 then
-	begin
-	  TagInfo := @HTMLElProps[j];
-	  break;
-	end;
+        begin
+          TagInfo := @HTMLElProps[j];
+          break;
+        end;
 
       Inc(i);
       while i < FNodeBuffer.Count do
       begin
         NodeInfo2 := THTMLNodeInfo(FNodeBuffer.Items[i]);
 
-	if (NodeInfo2.NodeType = ntWhitespace) and Assigned(TagInfo) and
-	  (not (efPreserveWhitespace in TagInfo^.Flags)) then
-	  // Handle whitespace, which doesn't need to get preserved...
-	  if not (efPCDATAContent in TagInfo^.Flags) then
-	    // No character data allowed within the current element
-	    NodeInfo2.DOMNode.Free
-	  else
-	  begin
-	    // Character data allowed, so normalize it
-	    NodeInfo2.DOMNode.NodeValue := ' ';
+        if (NodeInfo2.NodeType = ntWhitespace) and Assigned(TagInfo) and
+          (not (efPreserveWhitespace in TagInfo^.Flags)) then
+          // Handle whitespace, which doesn't need to get preserved...
+          if not (efPCDATAContent in TagInfo^.Flags) then
+            // No character data allowed within the current element
+            NodeInfo2.DOMNode.Free
+          else
+          begin
+            // Character data allowed, so normalize it
+            NodeInfo2.DOMNode.NodeValue := ' ';
             NodeInfo.DOMNode.AppendChild(NodeInfo2.DOMNode)
-	  end
-	else
-	  NodeInfo.DOMNode.AppendChild(NodeInfo2.DOMNode);
+          end
+        else
+          NodeInfo.DOMNode.AppendChild(NodeInfo2.DOMNode);
 
-	NodeInfo2.Free;
-	FNodeBuffer.Delete(i);
+        NodeInfo2.Free;
+        FNodeBuffer.Delete(i);
       end;
       break;
     end;
@@ -649,7 +649,10 @@ end.
 
 {
   $Log$
-  Revision 1.5  2003-03-16 22:38:09  sg
+  Revision 1.6  2004-11-05 22:32:28  peter
+    * merged xml updates from lazarus
+
+  Revision 1.5  2003/03/16 22:38:09  sg
   * Added fragment parsing functions
 
   Revision 1.4  2002/12/14 19:18:21  sg

+ 166 - 61
fcl/xml/xmlcfg.pp

@@ -25,12 +25,17 @@
 unit XMLCfg;
 
 interface
-uses Classes, DOM, XMLRead, XMLWrite;
+
+{off $DEFINE MEM_CHECK}
+
+uses
+  {$IFDEF MEM_CHECK}MemCheck,{$ENDIF}
+  Classes, DOM, XMLRead, XMLWrite;
 
 type
 
   {"APath" is the path and name of a value: A XML configuration file is
-   hierarchical. "/" is the path delimiter, the part after the last "/"
+   hierachical. "/" is the path delimiter, the part after the last "/"
    is the name of the value. The path components will be mapped to XML
    elements, the name will be an element attribute.}
 
@@ -41,17 +46,26 @@ type
   protected
     doc: TXMLDocument;
     FModified: Boolean;
+    fDoNotLoad: boolean;
     procedure Loaded; override;
+    function FindNode(const APath: String; PathHasValue: boolean): TDomNode;
   public
-    constructor Create(const AFilename: String);
+    constructor Create(const AFilename: String); overload;
+    constructor CreateClean(const AFilename: String);
     destructor Destroy; override;
+    procedure Clear;
     procedure Flush;    // Writes the XML file
     function  GetValue(const APath, ADefault: String): String;
     function  GetValue(const APath: String; ADefault: Integer): Integer;
     function  GetValue(const APath: String; ADefault: Boolean): Boolean;
     procedure SetValue(const APath, AValue: String);
+    procedure SetDeleteValue(const APath, AValue, DefValue: String);
     procedure SetValue(const APath: String; AValue: Integer);
+    procedure SetDeleteValue(const APath: String; AValue, DefValue: Integer);
     procedure SetValue(const APath: String; AValue: Boolean);
+    procedure SetDeleteValue(const APath: String; AValue, DefValue: Boolean);
+    procedure DeletePath(const APath: string);
+    procedure DeleteValue(const APath: string);
     property Modified: Boolean read FModified;
   published
     property Filename: String read FFilename write SetFilename;
@@ -71,6 +85,13 @@ begin
   SetFilename(AFilename);
 end;
 
+constructor TXMLConfig.CreateClean(const AFilename: String);
+begin
+  inherited Create(nil);
+  fDoNotLoad:=true;
+  SetFilename(AFilename);
+end;
+
 destructor TXMLConfig.Destroy;
 begin
   if Assigned(doc) then
@@ -81,19 +102,26 @@ begin
   inherited Destroy;
 end;
 
-procedure TXMLConfig.Flush;
+procedure TXMLConfig.Clear;
 var
-  f: Text;
+  cfg: TDOMElement;
+begin
+  // free old document
+  doc.Free;
+  // create new document
+  doc := TXMLDocument.Create;
+  cfg :=TDOMElement(doc.FindNode('CONFIG'));
+  if not Assigned(cfg) then begin
+    cfg := doc.CreateElement('CONFIG');
+    doc.AppendChild(cfg);
+  end;
+end;
+
+procedure TXMLConfig.Flush;
 begin
   if Modified then
   begin
-    AssignFile(f, Filename);
-    Rewrite(f);
-    try
-      WriteXMLFile(doc, f);
-    finally
-      CloseFile(f);
-    end;
+    WriteXMLFile(doc, Filename);
     FModified := False;
   end;
 end;
@@ -101,35 +129,36 @@ end;
 function TXMLConfig.GetValue(const APath, ADefault: String): String;
 var
   Node, Child, Attr: TDOMNode;
-  i: Integer;
-  NodePath: String;
+  NodeName: String;
+  PathLen: integer;
+  StartPos, EndPos: integer;
 begin
+  Result:=ADefault;
+  PathLen:=length(APath);
   Node := doc.DocumentElement;
-  NodePath := APath;
-  while True do
-  begin
-    i := Pos('/', NodePath);
-    if i = 0 then
-      break;
-    Child := Node.FindNode(Copy(NodePath, 1, i - 1));
-    NodePath := Copy(NodePath, i + 1, Length(NodePath));
-    if not Assigned(Child) then
-    begin
-      Result := ADefault;
-      exit;
-    end;
+  StartPos:=1;
+  while True do begin
+    EndPos:=StartPos;
+    while (EndPos<=PathLen) and (APath[EndPos]<>'/') do inc(EndPos);
+    if EndPos>PathLen then break;
+    SetLength(NodeName,EndPos-StartPos);
+    Move(APath[StartPos],NodeName[1],EndPos-StartPos);
+    StartPos:=EndPos+1;
+    Child := Node.FindNode(NodeName);
+    if not Assigned(Child) then exit;
     Node := Child;
   end;
-  Attr := Node.Attributes.GetNamedItem(NodePath);
+  if StartPos>PathLen then exit;
+  SetLength(NodeName,PathLen-StartPos+1);
+  Move(APath[StartPos],NodeName[1],length(NodeName));
+  Attr := Node.Attributes.GetNamedItem(NodeName);
   if Assigned(Attr) then
-    Result := Attr.NodeValue
-  else
-    Result := ADefault;
+    Result := Attr.NodeValue;
 end;
 
 function TXMLConfig.GetValue(const APath: String; ADefault: Integer): Integer;
 begin
-  Result := StrToInt(GetValue(APath, IntToStr(ADefault)));
+  Result := StrToIntDef(GetValue(APath, IntToStr(ADefault)),ADefault);
 end;
 
 function TXMLConfig.GetValue(const APath: String; ADefault: Boolean): Boolean;
@@ -143,9 +172,9 @@ begin
 
   s := GetValue(APath, s);
 
-  if UpperCase(s) = 'TRUE' then
+  if AnsiCompareText(s,'TRUE')=0 then
     Result := True
-  else if UpperCase(s) = 'FALSE' then
+  else if AnsiCompareText(s,'FALSE')=0 then
     Result := False
   else
     Result := ADefault;
@@ -153,19 +182,21 @@ end;
 
 procedure TXMLConfig.SetValue(const APath, AValue: String);
 var
-  Node, Child, Attr: TDOMNode;
-  i: Integer;
-  NodeName, NodePath: String;
+  Node, Child: TDOMNode;
+  NodeName: String;
+  PathLen: integer;
+  StartPos, EndPos: integer;
 begin
   Node := Doc.DocumentElement;
-  NodePath := APath;
-  while True do
-  begin
-    i := Pos('/', NodePath);
-    if i = 0 then
-      break;
-    NodeName := Copy(NodePath, 1, i - 1);
-    NodePath := Copy(NodePath, i + 1, Length(NodePath));
+  PathLen:=length(APath);
+  StartPos:=1;
+  while True do begin
+    EndPos:=StartPos;
+    while (EndPos<=PathLen) and (APath[EndPos]<>'/') do inc(EndPos);
+    if EndPos>PathLen then break;
+    SetLength(NodeName,EndPos-StartPos);
+    Move(APath[StartPos],NodeName[1],EndPos-StartPos);
+    StartPos:=EndPos+1;
     Child := Node.FindNode(NodeName);
     if not Assigned(Child) then
     begin
@@ -175,19 +206,39 @@ begin
     Node := Child;
   end;
 
-  if (not Assigned(TDOMElement(Node).GetAttributeNode(NodePath))) or
-    (TDOMElement(Node)[NodePath] <> AValue) then
+  if StartPos>PathLen then exit;
+  SetLength(NodeName,PathLen-StartPos+1);
+  Move(APath[StartPos],NodeName[1],length(NodeName));
+  if (not Assigned(TDOMElement(Node).GetAttributeNode(NodeName))) or
+    (TDOMElement(Node)[NodeName] <> AValue) then
   begin
-    TDOMElement(Node)[NodePath] := AValue;
+    TDOMElement(Node)[NodeName] := AValue;
     FModified := True;
   end;
 end;
 
+procedure TXMLConfig.SetDeleteValue(const APath, AValue, DefValue: String);
+begin
+  if AValue=DefValue then
+    DeleteValue(APath)
+  else
+    SetValue(APath,AValue);
+end;
+
 procedure TXMLConfig.SetValue(const APath: String; AValue: Integer);
 begin
   SetValue(APath, IntToStr(AValue));
 end;
 
+procedure TXMLConfig.SetDeleteValue(const APath: String; AValue,
+  DefValue: Integer);
+begin
+  if AValue=DefValue then
+    DeleteValue(APath)
+  else
+    SetValue(APath,AValue);
+end;
+
 procedure TXMLConfig.SetValue(const APath: String; AValue: Boolean);
 begin
   if AValue then
@@ -196,6 +247,41 @@ begin
     SetValue(APath, 'False');
 end;
 
+procedure TXMLConfig.SetDeleteValue(const APath: String; AValue,
+  DefValue: Boolean);
+begin
+  if AValue=DefValue then
+    DeleteValue(APath)
+  else
+    SetValue(APath,AValue);
+end;
+
+procedure TXMLConfig.DeletePath(const APath: string);
+var
+  Node: TDomNode;
+begin
+  Node:=FindNode(APath,false);
+  if (Node=nil) or (Node.ParentNode=nil) then exit;
+  Node.ParentNode.RemoveChild(Node);
+  FModified := True;
+end;
+
+procedure TXMLConfig.DeleteValue(const APath: string);
+var
+  Node: TDomNode;
+  StartPos: integer;
+  NodeName: string;
+begin
+  Node:=FindNode(APath,true);
+  if (Node=nil) then exit;
+  StartPos:=length(APath);
+  while (StartPos>0) and (APath[StartPos]<>'/') do dec(StartPos);
+  NodeName:=copy(APath,StartPos+1,length(APath)-StartPos);
+  if (not Assigned(TDOMElement(Node).GetAttributeNode(NodeName))) then exit;
+  TDOMElement(Node).RemoveAttribute(NodeName);
+  FModified := True;
+end;
+
 procedure TXMLConfig.Loaded;
 begin
   inherited Loaded;
@@ -203,11 +289,36 @@ begin
     SetFilename(Filename);              // Load the XML config file
 end;
 
+function TXMLConfig.FindNode(const APath: String;
+  PathHasValue: boolean): TDomNode;
+var
+  NodePath: String;
+  StartPos, EndPos: integer;
+  PathLen: integer;
+begin
+  Result := doc.DocumentElement;
+  PathLen:=length(APath);
+  StartPos:=1;
+  while (Result<>nil) do begin
+    EndPos:=StartPos;
+    while (EndPos<=PathLen) and (APath[EndPos]<>'/') do inc(EndPos);
+    if (EndPos>PathLen) and PathHasValue then exit;
+    if EndPos=StartPos then break;
+    SetLength(NodePath,EndPos-StartPos);
+    Move(APath[StartPos],NodePath[1],length(NodePath));
+    Result := Result.FindNode(NodePath);
+    StartPos:=EndPos+1;
+    if StartPos>PathLen then exit;
+  end;
+  Result:=nil;
+end;
+
 procedure TXMLConfig.SetFilename(const AFilename: String);
 var
-  f: File;
   cfg: TDOMElement;
 begin
+  {$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLConfig.SetFilename A '+AFilename);{$ENDIF}
+  if FFilename = AFilename then exit;
   FFilename := AFilename;
 
   if csLoading in ComponentState then
@@ -219,16 +330,9 @@ begin
     doc.Free;
   end;
 
-  AssignFile(f, AFileName);
-  {$I-}
-  Reset(f, 1);
-  {$I+}
-  if IOResult = 0 then
-    try
-      ReadXMLFile(doc, f);
-    finally
-      CloseFile(f);
-    end;
+  doc:=nil;
+  if FileExists(AFilename) and (not fDoNotLoad) then
+    ReadXMLFile(doc,AFilename);
 
   if not Assigned(doc) then
     doc := TXMLDocument.Create;
@@ -238,13 +342,14 @@ begin
     cfg := doc.CreateElement('CONFIG');
     doc.AppendChild(cfg);
   end;
+  {$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLConfig.SetFilename END');{$ENDIF}
 end;
 
 
 end.
 {
   $Log$
-  Revision 1.5  2002-09-07 15:15:29  peter
-    * old logs removed and tabs fixed
+  Revision 1.6  2004-11-05 22:32:28  peter
+    * merged xml updates from lazarus
 
 }

File diff suppressed because it is too large
+ 418 - 176
fcl/xml/xmlread.pp


+ 167 - 149
fcl/xml/xmlwrite.pp

@@ -3,9 +3,9 @@
     This file is part of the Free Component Library
 
     XML writing routines
-    Copyright (c) 1999-2003 by Sebastian Guenther, [email protected]
+    Copyright (c) 1999-2000 by Sebastian Guenther, [email protected]
 
-    See the file COPYING.FPC, included in this distribution,
+    See the file COPYING.modifiedLGPL, included in this distribution,
     for details about the copyright.
 
     This program is distributed in the hope that it will be useful,
@@ -17,6 +17,9 @@
 
 unit XMLWrite;
 
+{$MODE objfpc}
+{$H+}
+
 interface
 
 uses Classes, DOM;
@@ -25,9 +28,9 @@ procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String); overload;
 procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text); overload;
 procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream); overload;
 
-procedure WriteXML(Node: TDOMNode; const AFileName: String); overload;
-procedure WriteXML(Node: TDOMNode; var AFile: Text); overload;
-procedure WriteXML(Node: TDOMNode; AStream: TStream); overload;
+procedure WriteXML(Element: TDOMElement; const AFileName: String); overload;
+procedure WriteXML(Element: TDOMElement; var AFile: Text); overload;
+procedure WriteXML(Element: TDOMElement; AStream: TStream); overload;
 
 
 // ===================================================================
@@ -59,15 +62,9 @@ type
 
 const
   WriteProcs: array[ELEMENT_NODE..NOTATION_NODE] of TWriteNodeProc =
-{$IFDEF FPC}
     (@WriteElement, @WriteAttribute, @WriteText, @WriteCDATA, @WriteEntityRef,
      @WriteEntity, @WritePI, @WriteComment, @WriteDocument, @WriteDocumentType,
      @WriteDocumentFragment, @WriteNotation);
-{$ELSE}
-    (WriteElement, WriteAttribute, WriteText, WriteCDATA, WriteEntityRef,
-     WriteEntity, WritePI, WriteComment, WriteDocument, WriteDocumentType,
-     WriteDocumentFragment, WriteNotation);
-{$ENDIF}
 
 procedure WriteNode(node: TDOMNode);
 begin
@@ -80,58 +77,94 @@ end;
 // -------------------------------------------------------------------
 
 type
-  TOutputProc = procedure(const s: String);
+  TOutputProc = procedure(const Buffer; Count: Longint);
 
-var
+threadvar
   f: ^Text;
   stream: TStream;
   wrt, wrtln: TOutputProc;
   InsideTextNode: Boolean;
 
+procedure Text_Write(const Buffer; Count: Longint);
+var s: string;
+begin
+  if Count>0 then begin
+    SetLength(s,Count);
+    System.Move(Buffer,s[1],Count);
+    Write(f^, s);
+  end;
+end;
+
+procedure Text_WriteLn(const Buffer; Count: Longint);
+var s: string;
+begin
+  if Count>0 then begin
+    SetLength(s,Count);
+    System.Move(Buffer,s[1],Count);
+    writeln(f^, s);
+  end;
+end;
 
-procedure Text_Write(const s: String);
+procedure Stream_Write(const Buffer; Count: Longint);
 begin
-  Write(f^, s);
+  if Count > 0 then begin
+    stream.Write(Buffer, Count);
+  end;
 end;
 
-procedure Text_WriteLn(const s: String);
+procedure Stream_WriteLn(const Buffer; Count: Longint);
 begin
-  WriteLn(f^, s);
+  if Count > 0 then begin
+    stream.Write(Buffer, Count);
+    stream.WriteByte(10);
+  end;
 end;
 
-procedure Stream_Write(const s: String);
+procedure wrtStr(const s: string);
 begin
-  if Length(s) > 0 then
-    Stream.Write(s[1], Length(s));
+  if s<>'' then
+    wrt(s[1],length(s));
 end;
 
-procedure Stream_WriteLn(const s: String);
-const
-  LF: Char = #10;
+procedure wrtStrLn(const s: string);
+begin
+  if s<>'' then
+    wrtln(s[1],length(s));
+end;
+
+procedure wrtChr(c: char);
 begin
-  if Length(s) > 0 then
-    Stream.Write(s[1], Length(s));
-  Stream.Write(LF, 1);
+  wrt(c,1);
 end;
 
+procedure wrtLineEnd;
+begin
+  wrt(#10,1);
+end;
 
 // -------------------------------------------------------------------
 //   Indent handling
 // -------------------------------------------------------------------
 
-var
+threadvar
   Indent: String;
+  IndentCount: integer;
 
+procedure wrtIndent;
+var i: integer;
+begin
+  for i:=1 to IndentCount do
+    wrtStr(Indent);
+end;
 
 procedure IncIndent;
 begin
-  Indent := Indent + '  ';
+  inc(IndentCount);
 end;
 
 procedure DecIndent;
 begin
-  if Length(Indent) >= 2 then
-    SetLength(Indent, Length(Indent) - 2);
+  if IndentCount>0 then dec(IndentCount);
 end;
 
 
@@ -159,40 +192,43 @@ begin
   begin
     if s[EndPos] in SpecialChars then
     begin
-      wrt(Copy(s, StartPos, EndPos - StartPos));
+      wrt(s[StartPos],EndPos - StartPos);
       SpecialCharCallback(s[EndPos]);
       StartPos := EndPos + 1;
     end;
     Inc(EndPos);
   end;
-  if EndPos > StartPos then
-    wrt(Copy(s, StartPos, EndPos - StartPos));
+  if StartPos <= length(s) then
+    wrt(s[StartPos], EndPos - StartPos);
 end;
 
 procedure AttrSpecialCharCallback(c: Char);
+const
+  QuotStr = '&quot;';
+  AmpStr = '&amp;';
 begin
-  if c = '<' then
-    wrt('&lt;')
-  else if c = '>' then
-    wrt('&gt;')
-  else if c = '"' then
-    wrt('&quot;')
+  if c = '"' then
+    wrtStr(QuotStr)
   else if c = '&' then
-    wrt('&amp;')
+    wrtStr(AmpStr)
   else
-    wrt(c);
+    wrt(c,1);
 end;
 
 procedure TextnodeSpecialCharCallback(c: Char);
+const
+  ltStr = '&lt;';
+  gtStr = '&gt;';
+  AmpStr = '&amp;';
 begin
   if c = '<' then
-    wrt('&lt;')
+    wrtStr(ltStr)
   else if c = '>' then
-    wrt('&gt;')
+    wrtStr(gtStr)
   else if c = '&' then
-    wrt('&amp;')
+    wrtStr(AmpStr)
   else
-    wrt(c);
+    wrt(c,1);
 end;
 
 
@@ -208,30 +244,32 @@ var
   s: String;
 begin
   if not InsideTextNode then
-    wrt(Indent);
-  wrt('<' + node.NodeName);
+    wrtIndent;
+  wrtChr('<');
+  wrtStr(node.NodeName);
   for i := 0 to node.Attributes.Length - 1 do
   begin
     attr := node.Attributes.Item[i];
-    wrt(' ' + attr.NodeName + '=');
+    wrtChr(' ');
+    wrtStr(attr.NodeName);
+    wrtChr('=');
     s := attr.NodeValue;
-    wrt('"');
+    // !!!: Replace special characters in "s" such as '&', '<', '>'
+    wrtChr('"');
     ConvWrite(s, AttrSpecialChars, @AttrSpecialCharCallback);
-    wrt('"');
+    wrtChr('"');
   end;
   Child := node.FirstChild;
-  if Child = nil then
-    if InsideTextNode then
-      wrt('/>')
-    else
-      wrtln('/>')
-  else
+  if Child = nil then begin
+    wrtChr('/');
+    wrtChr('>');
+    if not InsideTextNode then wrtLineEnd;
+  end else
   begin
     SavedInsideTextNode := InsideTextNode;
-    if InsideTextNode or Child.InheritsFrom(TDOMText) then
-      wrt('>')
-    else
-      wrtln('>');
+    wrtChr('>');
+    if not (InsideTextNode or Child.InheritsFrom(TDOMText)) then
+      wrtLineEnd;
     IncIndent;
     repeat
       if Child.InheritsFrom(TDOMText) then
@@ -241,82 +279,88 @@ begin
     until child = nil;
     DecIndent;
     if not InsideTextNode then
-      wrt(Indent);
+      wrtIndent;
     InsideTextNode := SavedInsideTextNode;
-    s := '</' + node.NodeName + '>';
-    if InsideTextNode then
-      wrt(s)
-    else
-      wrtln(s);
+    wrtChr('<');
+    wrtChr('/');
+    wrtStr(node.NodeName);
+    wrtChr('>');
+    if not InsideTextNode then
+      wrtLineEnd;
   end;
 end;
 
 procedure WriteAttribute(node: TDOMNode);
 begin
-  WriteLn('WriteAttribute');
+  if node=nil then ;
 end;
 
 procedure WriteText(node: TDOMNode);
 begin
   ConvWrite(node.NodeValue, TextSpecialChars, @TextnodeSpecialCharCallback);
+  if node=nil then ;
 end;
 
 procedure WriteCDATA(node: TDOMNode);
 begin
-  if InsideTextNode then
-    wrt('<![CDATA[' + node.NodeValue + ']]>')
-  else
-    wrtln(Indent + '<![CDATA[' + node.NodeValue + ']]>')
+  if not InsideTextNode then
+    wrtStr('<![CDATA[' + node.NodeValue + ']]>')
+  else begin
+    wrtIndent;
+    wrtStrln('<![CDATA[' + node.NodeValue + ']]>')
+  end;
 end;
 
 procedure WriteEntityRef(node: TDOMNode);
 begin
-  wrt('&' + node.NodeName + ';');
+  wrtChr('&');
+  wrtStr(node.NodeName);
+  wrtChr(';');
 end;
 
 procedure WriteEntity(node: TDOMNode);
 begin
-  WriteLn('WriteEntity');
+  if node=nil then ;
 end;
 
 procedure WritePI(node: TDOMNode);
-var
-  s: String;
 begin
-  s := '<!' + TDOMProcessingInstruction(node).Target + ' ' +
-    TDOMProcessingInstruction(node).Data + '>';
-  if InsideTextNode then
-    wrt(s)
-  else
-    wrtln(Indent + s);
+  if not InsideTextNode then wrtIndent;
+  wrtChr('<'); wrtChr('!');
+  wrtStr(TDOMProcessingInstruction(node).Target);
+  wrtChr(' ');
+  wrtStr(TDOMProcessingInstruction(node).Data);
+  wrtChr('>');
+  if not InsideTextNode then wrtLineEnd;
 end;
 
 procedure WriteComment(node: TDOMNode);
 begin
-  if InsideTextNode then
-    wrt('<!--' + node.NodeValue + '-->')
-  else
-    wrtln(Indent + '<!--' + node.NodeValue + '-->')
+  if not InsideTextNode then wrtIndent;
+  wrtStr('<!--');
+  wrtStr(node.NodeValue);
+  wrtStr('-->');
+  if not InsideTextNode then wrtLineEnd;
 end;
 
 procedure WriteDocument(node: TDOMNode);
 begin
-  WriteLn('WriteDocument');
+  if node=nil then ;
 end;
 
 procedure WriteDocumentType(node: TDOMNode);
 begin
-  WriteLn('WriteDocumentType');
+  if node=nil then ;
 end;
 
 procedure WriteDocumentFragment(node: TDOMNode);
 begin
-  WriteLn('WriteDocumentFragment');
+  if node=nil then ;
 end;
 
 procedure WriteNotation(node: TDOMNode);
 begin
-  WriteLn('WriteNotation');
+  if node=nil then ;
 end;
 
 
@@ -331,30 +375,31 @@ var
   Child: TDOMNode;
 begin
   InitWriter;
-  wrt('<?xml version="');
+  wrtStr('<?xml version="');
   if Length(doc.XMLVersion) > 0 then
     ConvWrite(doc.XMLVersion, AttrSpecialChars, @AttrSpecialCharCallback)
   else
-    wrt('1.0');
-  wrt('"');
+    wrtStr('1.0');
+  wrtChr('"');
   if Length(doc.Encoding) > 0 then
   begin
-    wrt(' encoding="');
+    wrtStr(' encoding="');
     ConvWrite(doc.Encoding, AttrSpecialChars, @AttrSpecialCharCallback);
-    wrt('"');
+    wrtStr('"');
   end;
-  wrtln('?>');
+  wrtStrln('?>');
 
   if Length(doc.StylesheetType) > 0 then
   begin
-    wrt('<?xml-stylesheet type="');
+    wrtStr('<?xml-stylesheet type="');
     ConvWrite(doc.StylesheetType, AttrSpecialChars, @AttrSpecialCharCallback);
-    wrt('" href="');
+    wrtStr('" href="');
     ConvWrite(doc.StylesheetHRef, AttrSpecialChars, @AttrSpecialCharCallback);
-    wrtln('"?>');
+    wrtStrln('"?>');
   end;
 
-  SetLength(Indent, 0);
+  Indent := '  ';
+  IndentCount := 0;
 
   child := doc.FirstChild;
   while Assigned(Child) do
@@ -365,6 +410,14 @@ begin
 end;
 
 
+procedure WriteXMLMemStream(doc: TXMLDocument);
+// internally used by the WriteXMLFile procedures
+begin
+  Stream:=TMemoryStream.Create;
+  WriteXMLFile(doc,Stream);
+  Stream.Position:=0;
+end;
+
 // -------------------------------------------------------------------
 //   Interface implementation
 // -------------------------------------------------------------------
@@ -413,25 +466,18 @@ const
 {$ENDIF}
 
 procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String);
-{$IFDEF UsesFPCWidestrings}
 var
-  OldWideStringManager: TWideStringManager;
-{$ENDIF}
+  fs: TFileStream;
 begin
-  {$IFDEF UsesFPCWidestrings}
-  SetWideStringManager(WideStringManager, OldWideStringManager);
+  // write first to memory buffer and then as one whole block to file
+  WriteXMLMemStream(doc);
   try
-  {$ENDIF}
-    Stream := TFileStream.Create(AFileName, fmCreate);
-    wrt := @Stream_Write;
-    wrtln := @Stream_WriteLn;
-    RootWriter(doc);
-    Stream.Free;
-  {$IFDEF UsesFPCWidestrings}
+    fs := TFileStream.Create(AFileName, fmCreate);
+    fs.CopyFrom(Stream,Stream.Size);
+    fs.Free;
   finally
-    SetWideStringManager(OldWideStringManager);
+    Stream.Free;
   end;
-  {$ENDIF}
 end;
 
 procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
@@ -477,7 +523,7 @@ begin
 end;
 
 
-procedure WriteXML(Node: TDOMNode; const AFileName: String);
+procedure WriteXML(Element: TDOMElement; const AFileName: String);
 {$IFDEF UsesFPCWidestrings}
 var
   OldWideStringManager: TWideStringManager;
@@ -491,7 +537,7 @@ begin
     wrt := @Stream_Write;
     wrtln := @Stream_WriteLn;
     InitWriter;
-    WriteNode(Node);
+    WriteNode(Element);
     Stream.Free;
   {$IFDEF UsesFPCWidestrings}
   finally
@@ -500,7 +546,7 @@ begin
   {$ENDIF}
 end;
 
-procedure WriteXML(Node: TDOMNode; var AFile: Text);
+procedure WriteXML(Element: TDOMElement; var AFile: Text);
 {$IFDEF UsesFPCWidestrings}
 var
   OldWideStringManager: TWideStringManager;
@@ -514,7 +560,7 @@ begin
     wrt := @Text_Write;
     wrtln := @Text_WriteLn;
     InitWriter;
-    WriteNode(Node);
+    WriteNode(Element);
   {$IFDEF UsesFPCWidestrings}
   finally
     SetWideStringManager(OldWideStringManager);
@@ -522,7 +568,7 @@ begin
   {$ENDIF}
 end;
 
-procedure WriteXML(Node: TDOMNode; AStream: TStream);
+procedure WriteXML(Element: TDOMElement; AStream: TStream);
 {$IFDEF UsesFPCWidestrings}
 var
   OldWideStringManager: TWideStringManager;
@@ -536,7 +582,7 @@ begin
     wrt := @Stream_Write;
     wrtln := @Stream_WriteLn;
     InitWriter;
-    WriteNode(Node);
+    WriteNode(Element);
   {$IFDEF UsesFPCWidestrings}
   finally
     SetWideStringManager(OldWideStringManager);
@@ -544,38 +590,10 @@ begin
   {$ENDIF}
 end;
 
-
 end.
-
-
 {
   $Log$
-  Revision 1.14  2004-05-02 20:17:53  peter
-    * use sizeint
-
-  Revision 1.13  2004/01/20 12:27:19  sg
-  * "<" and ">" are now written as "&lt;" and "&gt;"
-
-  Revision 1.12  2003/12/01 23:59:12  sg
-  * Added support for main branch to be able to read and write at least
-    ISO8859-1 encoded files correctly. A much improved solution will be
-    provided when the mainbranch RTL fully supports Unicode/WideStrings.
-
-  Revision 1.11  2003/01/15 21:59:55  sg
-  * the units DOM, XMLRead and XMLWrite now compile with Delphi without
-    modifications as well
-
-  Revision 1.10  2002/11/30 16:04:34  sg
-  * Stream parameters are not "var" anymore (stupid copy&paste bug)
-
-  Revision 1.9  2002/09/20 11:36:51  sg
-  * Argument escaping improvements
-  * Indent fixed for consecutive WriteXML calls
-
-  Revision 1.8  2002/09/20 11:04:21  michael
-  + Changed writexml type to TDomNode instead of TDomeElement
-
-  Revision 1.7  2002/09/07 15:15:29  peter
-    * old logs removed and tabs fixed
+  Revision 1.15  2004-11-05 22:32:28  peter
+    * merged xml updates from lazarus
 
 }

File diff suppressed because it is too large
+ 372 - 372
fcl/xml/xpath.pp


Some files were not shown because too many files changed in this diff