Browse Source

* Patch from Sergei Gorelkin:
- xmlwrite.pp: Implemented built-in buffering with simultaneous UTF8
encoding, which made it faster about 3 times.
- dom.pp: Implemented a number of missing methods; wrote a skeleton for
namespace support (not working yet); implemented timestamping for
TDOMNodeList (so it is rebuilt only when underlying nodes are
changed). The complete list of changes is in 'FIX:' and 'DONE:'
comments in dom.pp itself.
- xmlread.pp: Numerous fixes in order to improve performance and comply with
the testsuite.

git-svn-id: trunk@3973 -

michael 19 years ago
parent
commit
5f92ba07a6
5 changed files with 1218 additions and 547 deletions
  1. 1 0
      .gitattributes
  2. 393 148
      fcl/xml/dom.pp
  3. 217 0
      fcl/xml/names.inc
  4. 404 274
      fcl/xml/xmlread.pp
  5. 203 125
      fcl/xml/xmlwrite.pp

+ 1 - 0
.gitattributes

@@ -1062,6 +1062,7 @@ fcl/xml/fpmake.inc svneol=native#text/plain
 fcl/xml/fpmake.pp svneol=native#text/plain
 fcl/xml/fpmake.pp svneol=native#text/plain
 fcl/xml/htmldefs.pp svneol=native#text/plain
 fcl/xml/htmldefs.pp svneol=native#text/plain
 fcl/xml/htmwrite.pp svneol=native#text/plain
 fcl/xml/htmwrite.pp svneol=native#text/plain
+fcl/xml/names.inc svneol=native#text/plain
 fcl/xml/sax.pp svneol=native#text/plain
 fcl/xml/sax.pp svneol=native#text/plain
 fcl/xml/sax_html.pp svneol=native#text/plain
 fcl/xml/sax_html.pp svneol=native#text/plain
 fcl/xml/xhtml.pp svneol=native#text/plain
 fcl/xml/xhtml.pp svneol=native#text/plain

File diff suppressed because it is too large
+ 393 - 148
fcl/xml/dom.pp


+ 217 - 0
fcl/xml/names.inc

@@ -0,0 +1,217 @@
+{
+    This file is part of the Free Component Library
+
+    XML naming character tables, built upon w3.org specifications
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+type
+  TByteSet = set of Byte;
+  TNbPage = record
+  case Boolean of
+    False: (Init: array[0..7] of Cardinal);
+  	True: (Work: TByteSet);
+  end;
+
+const
+  namingBitmap: array[0..$27] of TNbPage = (
+// #00 - nothing allowed
+(Init: ($00000000, $00000000, $00000000, $00000000,
+        $00000000, $00000000, $00000000, $00000000)),
+// #01 - all allowed
+(Init: ($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF,
+        $FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF)),
+// #02 - $0000, NameStart
+(Init: ($00000000, $04000000, $87FFFFFE, $07FFFFFE,
+        $00000000, $00000000, $FF7FFFFF, $FF7FFFFF)),
+// #03 - $0100, both Name and NameStart
+(Init: ($FFFFFFFF, $7FF3FFFF, $FFFFFDFE, $7FFFFFFF,
+        $FFFFFFFF, $FFFFFFFF, $FFFFE00F, $FC31FFFF)),
+// #04 - $0200, NameStart
+(Init: ($00FFFFFF, $00000000, $FFFF0000, $FFFFFFFF,
+        $FFFFFFFF, $F80001FF, $00000003, $00000000)),
+// #05 - $0300, NameStart
+(Init: ($00000000, $00000000, $00000000, $00000000,
+        $FFFFD740, $FFFFFFFB, $547F7FFF, $000FFFFD)),
+// #06 - $0400, NameStart
+(Init: ($FFFFDFFE, $FFFFFFFF, $DFFEFFFF, $FFFFFFFF,
+        $FFFF0003, $FFFFFFFF, $FFFF199F, $033FCFFF)),
+// #07 - $0500, NameStart
+(Init: ($00000000, $FFFE0000, $027FFFFF, $FFFFFFFE,
+        $0000007F, $00000000, $FFFF0000, $000707FF)),
+// #08 - $0600, NameStart
+(Init: ($00000000, $07FFFFFE, $000007FE, $FFFE0000,
+        $FFFFFFFF, $7CFFFFFF, $002F7FFF, $00000060)),
+// #09 - $0900, NameStart
+(Init: ($FFFFFFE0, $23FFFFFF, $FF000000, $00000003,
+        $FFF99FE0, $03C5FDFF, $B0000000, $00030003)),
+// #0A - $0A00, NameStart
+(Init: ($FFF987E0, $036DFDFF, $5E000000, $001C0000,
+        $FFFBAFE0, $23EDFDFF, $00000000, $00000001)),
+// #0B - $0B00, NameStart
+(Init: ($FFF99FE0, $23CDFDFF, $B0000000, $00000003,
+        $D63DC7E0, $03BFC718, $00000000, $00000000)),
+// #0C - $0C00, NameStart
+(Init: ($FFFDDFE0, $03EFFDFF, $00000000, $00000003,
+        $FFFDDFE0, $03EFFDFF, $40000000, $00000003)),
+// #0D - $0D00, NameStart
+(Init: ($FFFDDFE0, $03FFFDFF, $00000000, $00000003,
+        $00000000, $00000000, $00000000, $00000000)),
+// #0E - $0E00, NameStart
+(Init: ($FFFFFFFE, $000D7FFF, $0000003F, $00000000,
+        $FEF02596, $200D6CAE, $0000001F, $00000000)),
+// #0F - $0F00, NameStart
+(Init: ($00000000, $00000000, $FFFFFEFF, $000003FF,
+        $00000000, $00000000, $00000000, $00000000)),
+// #10 - $1000, both Name and NameStart
+(Init: ($00000000, $00000000, $00000000, $00000000,
+        $00000000, $FFFFFFFF, $FFFF003F, $007FFFFF)),
+// #11 - $1100, both Name and NameStart
+(Init: ($0007DAED, $50000000, $82315001, $002C62AB,
+        $40000000, $F580C900, $00000007, $02010800)),
+// #12 - $1E00, both Name and NameStart
+(Init: ($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF,
+        $0FFFFFFF, $FFFFFFFF, $FFFFFFFF, $03FFFFFF)),
+// #13 - $1F00, both Name and NameStart
+(Init: ($3F3FFFFF, $FFFFFFFF, $AAFF3F3F, $3FFFFFFF,
+        $FFFFFFFF, $5FDFFFFF, $0FCF1FDC, $1FDC1FFF)),
+// #14 - $2100, NameStart
+(Init: ($00000000, $00004C40, $00000000, $00000000,
+        $00000007, $00000000, $00000000, $00000000)),
+// #15 - $3000, NameStart
+(Init: ($00000080, $000003FE, $FFFFFFFE, $FFFFFFFF,
+        $001FFFFF, $FFFFFFFE, $FFFFFFFF, $07FFFFFF)),
+// #16 - $3100, NameStart
+(Init: ($FFFFFFE0, $00001FFF, $00000000, $00000000,
+        $00000000, $00000000, $00000000, $00000000)),
+// #17 - $9F00, NameStart
+(Init: ($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF,
+        $FFFFFFFF, $0000003F, $00000000, $00000000)),
+// #18 - $D700, NameStart
+(Init: ($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF,
+        $FFFFFFFF, $0000000F, $00000000, $00000000)),
+
+// #19 - $0000, Names
+(Init: ($00000000, $07FF6000, $87FFFFFE, $07FFFFFE,
+        $00000000, $00800000, $FF7FFFFF, $FF7FFFFF)),
+// #1A - $0200, Names
+(Init: ($00FFFFFF, $00000000, $FFFF0000, $FFFFFFFF,
+        $FFFFFFFF, $F80001FF, $00030003, $00000000)),
+// #1B - $0300, Names
+(Init: ($FFFFFFFF, $FFFFFFFF, $0000003F, $00000003,
+        $FFFFD7C0, $FFFFFFFB, $547F7FFF, $000FFFFD)),
+// #1C $0400 - Names
+(Init: ($FFFFDFFE, $FFFFFFFF, $DFFEFFFF, $FFFFFFFF,
+        $FFFF007B, $FFFFFFFF, $FFFF199F, $033FCFFF)),
+// #1D $0500 - Names
+(Init: ($00000000, $FFFE0000, $027FFFFF, $FFFFFFFE,
+        $FFFE007F, $BBFFFFFB, $FFFF0016, $000707FF)),
+// #1E $0600 - Names
+(Init: ($00000000, $07FFFFFE, $0007FFFF, $FFFF03FF,
+        $FFFFFFFF, $7CFFFFFF, $FFEF7FFF, $03FF3DFF)),
+// #1F $0900 - Names
+(Init: ($FFFFFFEE, $F3FFFFFF, $FF1E3FFF, $0000FFCF,
+        $FFF99FEE, $D3C5FDFF, $B080399F, $0003FFCF)),
+// #20 $0A00 - Names
+(Init: ($FFF987E4, $D36DFDFF, $5E003987, $001FFFC0,
+        $FFFBAFEE, $F3EDFDFF, $00003BBF, $0000FFC1)),
+// #21 $0B00 - Names
+(Init: ($FFF99FEE, $F3CDFDFF, $B0C0398F, $0000FFC3,
+        $D63DC7EC, $C3BFC718, $00803DC7, $0000FF80)),
+// #22 $0C00 - Names
+(Init: ($FFFDDFEE, $C3EFFDFF, $00603DDF, $0000FFC3,
+        $FFFDDFEC, $C3EFFDFF, $40603DDF, $0000FFC3)),
+// #23 $0D00 - Names
+(Init: ($FFFDDFEC, $C3FFFDFF, $00803DCF, $0000FFC3,
+        $00000000, $00000000, $00000000, $00000000)),
+// #24 $0E00 - Names
+(Init: ($FFFFFFFE, $07FF7FFF, $03FF7FFF, $00000000,
+        $FEF02596, $3BFF6CAE, $03FF3F5F, $00000000)),
+// #25 $0F00 - Names
+(Init: ($03000000, $C2A003FF, $FFFFFEFF, $FFFE03FF,
+        $FEBF0FDF, $02FE3FFF, $00000000, $00000000)),
+// #26 $2000 - Names
+(Init: ($00000000, $00000000, $00000000, $00000000,
+        $00000000, $00000000, $1FFF0000, $00000002)),
+// #27 $3000 - Names
+(Init: ($000000A0, $003EFFFE, $FFFFFFFE, $FFFFFFFF,
+        $661FFFFF, $FFFFFFFE, $FFFFFFFF, $77FFFFFF))
+);
+
+
+  NameStartPages: array[0..255] of Byte = (
+$02, $03, $04, $05, $06, $07, $08, $00,
+$00, $09, $0A, $0B, $0C, $0D, $0E, $0F,
+$10, $11, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $12, $13,
+$00, $14, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$15, $16, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $17,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $18,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $00, $00);
+
+  namePages: array[0..255] of Byte = (
+$19, $03, $1A, $1B, $1C, $1D, $1E, $00,
+$00, $1F, $20, $21, $22, $23, $24, $25,
+$10, $11, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $12, $13,
+$26, $14, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$27, $16, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $17,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $01,
+$01, $01, $01, $01, $01, $01, $01, $18,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $00, $00,
+$00, $00, $00, $00, $00, $00, $00, $00);
+

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


+ 203 - 125
fcl/xml/xmlwrite.pp

@@ -19,8 +19,9 @@ unit XMLWrite;
 
 
 {$ifdef fpc}
 {$ifdef fpc}
 {$MODE objfpc}
 {$MODE objfpc}
-{$INLINE ON}
 {$H+}
 {$H+}
+{/$DEFINE HAS_INLINE}
+{$INLINE OFF}
 {$endif}
 {$endif}
 
 
 interface
 interface
@@ -42,33 +43,31 @@ implementation
 
 
 uses SysUtils;
 uses SysUtils;
 
 
-// -------------------------------------------------------------------
-//   Text file and TStream support
-// -------------------------------------------------------------------
-
 type
 type
-  TOutputProc = procedure(const Buffer; Count: Longint) of object;
   TCharacters = set of Char;
   TCharacters = set of Char;
-  TSpecialCharCallback = procedure(c: Char) of object;
+  TSpecialCharCallback = procedure(c: WideChar) of object;
 
 
   TXMLWriter = class(TObject)  // (TAbstractDOMVisitor)?
   TXMLWriter = class(TObject)  // (TAbstractDOMVisitor)?
   private
   private
     FInsideTextNode: Boolean;
     FInsideTextNode: Boolean;
-    FIndent: string;
+    FIndent: WideString;
     FIndentCount: Integer;
     FIndentCount: Integer;
-    procedure IncIndent; {$IFDEF FPC} inline; {$ENDIF}
-    procedure DecIndent; {$IFDEF FPC} inline; {$ENDIF}
-    procedure wrtStr(const s: string);
-    procedure wrtChr(c: char);
-    procedure wrtLineEnd; {$IFDEF FPC} inline; {$ENDIF}
-    procedure wrtIndent;
-    procedure ConvWrite(const s: String; const SpecialChars: TCharacters;
+    FBuffer: PChar;
+    FBufPos: PChar;
+    FCapacity: Integer;
+    procedure wrtChars(Buf: PWideChar; Length: Integer);
+    procedure IncIndent;
+    procedure DecIndent; {$IFDEF HAS_INLINE} inline; {$ENDIF}
+    procedure wrtStr(const ws: WideString); {$IFDEF HAS_INLINE} inline; {$ENDIF}
+    procedure wrtChr(c: WideChar); {$IFDEF HAS_INLINE} inline; {$ENDIF}
+    procedure wrtLineEnd; {$IFDEF HAS_INLINE} inline; {$ENDIF}
+    procedure wrtIndent; {$IFDEF HAS_INLINE} inline; {$ENDIF}
+    procedure ConvWrite(const s: WideString; const SpecialChars: TCharacters;
       const SpecialCharCallback: TSpecialCharCallback);
       const SpecialCharCallback: TSpecialCharCallback);
-    procedure AttrSpecialCharCallback(c: Char);
-    procedure TextNodeSpecialCharCallback(c: Char);
+    procedure AttrSpecialCharCallback(c: WideChar);
+    procedure TextNodeSpecialCharCallback(c: WideChar);
   protected
   protected
-    Procedure Write(Const Buffer; Count : Longint); virtual;Abstract;
-    Procedure Writeln(Const Buffer; Count : Longint); virtual;
+    procedure Write(const Buffer; Count: Longint); virtual; abstract;
     procedure WriteNode(Node: TDOMNode);
     procedure WriteNode(Node: TDOMNode);
     procedure VisitDocument(Node: TDOMNode);  // override;
     procedure VisitDocument(Node: TDOMNode);  // override;
     procedure VisitElement(Node: TDOMNode);
     procedure VisitElement(Node: TDOMNode);
@@ -82,46 +81,62 @@ type
     procedure VisitDocumentType(Node: TDOMNode);
     procedure VisitDocumentType(Node: TDOMNode);
     procedure VisitPI(Node: TDOMNode);
     procedure VisitPI(Node: TDOMNode);
     procedure VisitNotation(Node: TDOMNode);
     procedure VisitNotation(Node: TDOMNode);
+  public
+    constructor Create;
+    destructor Destroy; override;
   end;
   end;
 
 
   TTextXMLWriter = Class(TXMLWriter)
   TTextXMLWriter = Class(TXMLWriter)
   Private
   Private
     F : ^Text;
     F : ^Text;
-  Protected  
+  Protected
     Procedure Write(Const Buffer; Count : Longint);override;
     Procedure Write(Const Buffer; Count : Longint);override;
-  Public  
-    procedure WriteXML(Root: TDomNode; var AFile: Text); overload;
+  Public
+    constructor Create(var AFile: Text);
   end;
   end;
-  
+
   TStreamXMLWriter = Class(TXMLWriter)
   TStreamXMLWriter = Class(TXMLWriter)
   Private
   Private
     F : TStream;
     F : TStream;
-  Protected  
+  Protected
     Procedure Write(Const Buffer; Count : Longint);override;
     Procedure Write(Const Buffer; Count : Longint);override;
-  Public  
-    procedure WriteXML(Root: TDomNode; AStream : TStream); overload;
+  Public
+    constructor Create(AStream: TStream);
   end;
   end;
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
     TTextXMLWriter
     TTextXMLWriter
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
-  
+
+
+constructor TTextXMLWriter.Create(var AFile: Text);
+begin
+  inherited Create;
+  f := @AFile;
+end;
 
 
 procedure TTextXMLWriter.Write(const Buffer; Count: Longint);
 procedure TTextXMLWriter.Write(const Buffer; Count: Longint);
 var
 var
   s: string;
   s: string;
 begin
 begin
   if Count>0 then
   if Count>0 then
-    begin
-    SetString(s, PChar(Buffer), Count);
+  begin
+    SetString(s, PChar(@Buffer), Count);
     system.Write(f^, s);
     system.Write(f^, s);
-    end;
+  end;
 end;
 end;
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
     TStreamXMLWriter
     TStreamXMLWriter
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
+constructor TStreamXMLWriter.Create(AStream: TStream);
+begin
+  inherited Create;
+  F := AStream;
+end;
+
+
 procedure TStreamXMLWriter.Write(const Buffer; Count: Longint);
 procedure TStreamXMLWriter.Write(const Buffer; Count: Longint);
 begin
 begin
   if Count > 0 then
   if Count > 0 then
@@ -133,44 +148,103 @@ end;
     TXMLWriter
     TXMLWriter
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
-Procedure TXMLWriter.Writeln(Const Buffer; Count : Longint); 
+constructor TXMLWriter.Create;
+var
+  I: Integer;
+begin
+  inherited Create;
+  // some overhead - always be able to write at least one extra UCS4
+  FBuffer := AllocMem(512+32);
+  FBufPos := FBuffer;
+  FCapacity := 512;
+  // Initialize Indent string
+  SetLength(FIndent, 100);
+  for I := 1 to 100 do FIndent[I] := ' ';
+  FIndentCount := 0;
+end;
 
 
+destructor TXMLWriter.Destroy;
 begin
 begin
-  Write(buffer,count);
-  Wrtstr(slinebreak);
+  if FBufPos > FBuffer then
+    write(FBuffer^, FBufPos-FBuffer);
+
+  FreeMem(FBuffer);
+  inherited Destroy;
 end;
 end;
 
 
+procedure TXMLWriter.wrtChars(Buf: PWideChar; Length: Integer);
+var
+  pb: PChar;
+  wc: Cardinal;
+  I: Integer;
+begin
+  pb := FBufPos;
+  for I := 0 to Length-1 do
+  begin
+    if pb >= @FBuffer[FCapacity] then
+    begin
+      write(FBuffer^, FCapacity);
+      Dec(pb, FCapacity);
+      if pb > FBuffer then
+        Move(FBuffer[FCapacity], FBuffer^, pb - FBuffer);
+    end;
 
 
-procedure TXMLWriter.wrtStr(const s: string);
+    wc := Cardinal(Buf^);  Inc(Buf);
+    if wc <= $7F then
+    begin
+      pb^ := char(wc); Inc(pb);
+    end
+    else if wc > $7FF then
+    begin
+      pb^ := Char($E0 or (wc shr 12));          Inc(pb);
+      pb^ := Char($80 or ((wc shr 6) and $3F)); Inc(pb);
+      pb^ := Char($80 or (wc and $3F));         Inc(pb);
+    end
+    else  // $7f < wc <= $7FF
+    begin
+      pb^ := Char($C0 or (wc shr 6));   Inc(pb);
+      pb^ := Char($80 or (wc and $3F)); Inc(pb);
+    end;
+  end;
+  FBufPos := pb;
+end;
+
+procedure TXMLWriter.wrtStr(const ws: WideString); { inline }
 begin
 begin
-  if s<>'' then
-    write(s[1],length(s));
+  wrtChars(PWideChar(ws), Length(ws));
 end;
 end;
 
 
-procedure TXMLWriter.wrtChr(c: char);
+procedure TXMLWriter.wrtChr(c: WideChar); { inline }
 begin
 begin
-  write(c,1);
+  wrtChars(@c,1);
 end;
 end;
 
 
-procedure TXMLWriter.wrtLineEnd;
+procedure TXMLWriter.wrtLineEnd; { inline }
 begin
 begin
-  wrtstr(slinebreak);
+  wrtStr(slinebreak);
 end;
 end;
 
 
-procedure TXMLWriter.wrtIndent;
-var
-  I: Integer;
+procedure TXMLWriter.wrtIndent; { inline }
 begin
 begin
-  for I:=1 to FIndentCount do
-    wrtStr(FIndent);
+  wrtChars(PWideChar(FIndent), FIndentCount*2);
 end;
 end;
 
 
 procedure TXMLWriter.IncIndent;
 procedure TXMLWriter.IncIndent;
+var
+  I, NewLen, OldLen: Integer;
 begin
 begin
   Inc(FIndentCount);
   Inc(FIndentCount);
+  if Length(FIndent) < 2 * FIndentCount then
+  begin
+    OldLen := Length(FIndent);
+    NewLen := 4 * FIndentCount;
+    SetLength(FIndent, NewLen);
+    for I := OldLen to NewLen do
+      FIndent[I] := ' ';
+  end;
 end;
 end;
 
 
-procedure TXMLWriter.DecIndent;
+procedure TXMLWriter.DecIndent; { inline }
 begin
 begin
   if FIndentCount>0 then dec(FIndentCount);
   if FIndentCount>0 then dec(FIndentCount);
 end;
 end;
@@ -179,7 +253,7 @@ const
   AttrSpecialChars = ['<', '>', '"', '&'];
   AttrSpecialChars = ['<', '>', '"', '&'];
   TextSpecialChars = ['<', '>', '&'];
   TextSpecialChars = ['<', '>', '&'];
 
 
-procedure TXMLWriter.ConvWrite(const s: String; const SpecialChars: TCharacters;
+procedure TXMLWriter.ConvWrite(const s: WideString; const SpecialChars: TCharacters;
   const SpecialCharCallback: TSpecialCharCallback);
   const SpecialCharCallback: TSpecialCharCallback);
 var
 var
   StartPos, EndPos: Integer;
   StartPos, EndPos: Integer;
@@ -188,19 +262,19 @@ begin
   EndPos := 1;
   EndPos := 1;
   while EndPos <= Length(s) do
   while EndPos <= Length(s) do
   begin
   begin
-    if s[EndPos] in SpecialChars then
+    if (s[EndPos] < #255) and (Char(s[EndPos]) in SpecialChars) then
     begin
     begin
-      write(s[StartPos],EndPos - StartPos);
+      wrtChars(@s[StartPos], EndPos - StartPos);
       SpecialCharCallback(s[EndPos]);
       SpecialCharCallback(s[EndPos]);
       StartPos := EndPos + 1;
       StartPos := EndPos + 1;
     end;
     end;
     Inc(EndPos);
     Inc(EndPos);
   end;
   end;
   if StartPos <= length(s) then
   if StartPos <= length(s) then
-    write(s[StartPos], EndPos - StartPos);
+    wrtChars(@s[StartPos], EndPos - StartPos);
 end;
 end;
 
 
-procedure TXMLWriter.AttrSpecialCharCallback(c: Char);
+procedure TXMLWriter.AttrSpecialCharCallback(c: WideChar);
 const
 const
   QuotStr = '&quot;';
   QuotStr = '&quot;';
   AmpStr = '&amp;';
   AmpStr = '&amp;';
@@ -213,10 +287,10 @@ begin
   else if c = '<' then
   else if c = '<' then
     wrtStr(ltStr)
     wrtStr(ltStr)
   else
   else
-    write(c,1);
+    wrtChr(c);
 end;
 end;
 
 
-procedure TXMLWriter.TextnodeSpecialCharCallback(c: Char);
+procedure TXMLWriter.TextnodeSpecialCharCallback(c: WideChar);
 const
 const
   ltStr = '&lt;';
   ltStr = '&lt;';
   gtStr = '&gt;';
   gtStr = '&gt;';
@@ -229,7 +303,7 @@ begin
   else if c = '&' then
   else if c = '&' then
     wrtStr(AmpStr)
     wrtStr(AmpStr)
   else
   else
-    write(c,1);
+    wrtChr(c);
 end;
 end;
 
 
 procedure TXMLWriter.WriteNode(node: TDOMNode);
 procedure TXMLWriter.WriteNode(node: TDOMNode);
@@ -257,77 +331,78 @@ var
   i: Integer;
   i: Integer;
   attr, child: TDOMNode;
   attr, child: TDOMNode;
   SavedInsideTextNode: Boolean;
   SavedInsideTextNode: Boolean;
-  s: DOMString;
+  IsLeaf: Boolean;
+  MixedContent: Boolean;
 begin
 begin
   if not FInsideTextNode then
   if not FInsideTextNode then
     wrtIndent;
     wrtIndent;
   wrtChr('<');
   wrtChr('<');
-  wrtStr(UTF8Encode(node.NodeName));
-  for i := 0 to node.Attributes.Length - 1 do
-  begin
-    attr := node.Attributes.Item[i];
-    wrtChr(' ');
-    wrtStr(UTF8Encode(attr.NodeName));
-    wrtChr('=');
-    s := attr.NodeValue;
-    // !!!: Replace special characters in "s" such as '&', '<', '>'
-    wrtChr('"');
-    ConvWrite(UTF8Encode(s), AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback);
-    wrtChr('"');
-  end;
+  wrtStr(node.NodeName);
+  // FIX: Accessing Attributes was causing them to be created for every element :(
+  if node.HasAttributes then
+    for i := 0 to node.Attributes.Length - 1 do
+    begin
+      attr := node.Attributes.Item[i];
+      VisitAttribute(attr);
+    end;
   Child := node.FirstChild;
   Child := node.FirstChild;
-  if Child = nil then begin
-    wrtChr('/');
-    wrtChr('>');
-    if not FInsideTextNode then wrtLineEnd;
-  end else
+  if Child = nil then
+    wrtStr('/>')
+  else
   begin
   begin
     SavedInsideTextNode := FInsideTextNode;
     SavedInsideTextNode := FInsideTextNode;
     wrtChr('>');
     wrtChr('>');
-    if not (FInsideTextNode or Child.InheritsFrom(TDOMText)) then
+    MixedContent := False;
+    repeat
+      if Assigned(Child.PreviousSibling) and
+        (Child.PreviousSibling.InheritsFrom(TDOMText) <> Child.InheritsFrom(TDOMText)) then
+        MixedContent := True;
+      Child := Child.NextSibling;
+    until Child = nil;
+    Child := node.FirstChild; // restore
+
+    IsLeaf := (Child = node.LastChild) and (Child.FirstChild = nil);
+    if not (FInsideTextNode or MixedContent or IsLeaf) then
       wrtLineEnd;
       wrtLineEnd;
+
+    FInsideTextNode := {FInsideTextNode or} MixedContent or IsLeaf;
     IncIndent;
     IncIndent;
     repeat
     repeat
-      if Child.InheritsFrom(TDOMText) then
-        FInsideTextNode := True
-      else                      // <-- fix case when CDATA is first child
-        FInsideTextNode := False;
       WriteNode(Child);
       WriteNode(Child);
       Child := Child.NextSibling;
       Child := Child.NextSibling;
-    until child = nil;
+    until Child = nil;
     DecIndent;
     DecIndent;
     if not FInsideTextNode then
     if not FInsideTextNode then
       wrtIndent;
       wrtIndent;
     FInsideTextNode := SavedInsideTextNode;
     FInsideTextNode := SavedInsideTextNode;
-    wrtChr('<');
-    wrtChr('/');
-    wrtStr(UTF8Encode(node.NodeName));
+    wrtStr('</');
+    wrtStr(Node.NodeName);
     wrtChr('>');
     wrtChr('>');
-    if not FInsideTextNode then
-      wrtLineEnd;
   end;
   end;
+  if not FInsideTextNode then
+    wrtLineEnd;
 end;
 end;
 
 
 procedure TXMLWriter.VisitText(node: TDOMNode);
 procedure TXMLWriter.VisitText(node: TDOMNode);
 begin
 begin
-  ConvWrite(UTF8Encode(node.NodeValue), TextSpecialChars, {$IFDEF FPC}@{$ENDIF}TextnodeSpecialCharCallback);
+  ConvWrite(node.NodeValue, TextSpecialChars, {$IFDEF FPC}@{$ENDIF}TextnodeSpecialCharCallback);
 end;
 end;
 
 
 procedure TXMLWriter.VisitCDATA(node: TDOMNode);
 procedure TXMLWriter.VisitCDATA(node: TDOMNode);
 begin
 begin
   if not FInsideTextNode then
   if not FInsideTextNode then
-    wrtStr('<![CDATA[' + UTF8Encode(node.NodeValue) + ']]>')
-  else begin
     wrtIndent;
     wrtIndent;
-    wrtStr('<![CDATA[' + UTF8Encode(node.NodeValue) + ']]>');
+  wrtStr('<![CDATA[');
+  wrtStr(node.NodeValue);
+  wrtStr(']]>');
+  if not FInsideTextNode then
     wrtLineEnd;
     wrtLineEnd;
-  end;
 end;
 end;
 
 
 procedure TXMLWriter.VisitEntityRef(node: TDOMNode);
 procedure TXMLWriter.VisitEntityRef(node: TDOMNode);
 begin
 begin
   wrtChr('&');
   wrtChr('&');
-  wrtStr(UTF8Encode(node.NodeName));
+  wrtStr(node.NodeName);
   wrtChr(';');
   wrtChr(';');
 end;
 end;
 
 
@@ -339,11 +414,11 @@ end;
 procedure TXMLWriter.VisitPI(node: TDOMNode);
 procedure TXMLWriter.VisitPI(node: TDOMNode);
 begin
 begin
   if not FInsideTextNode then wrtIndent;
   if not FInsideTextNode then wrtIndent;
-  wrtChr('<'); wrtChr('?');
-  wrtStr(UTF8Encode(TDOMProcessingInstruction(node).Target));
+  wrtStr('<?');
+  wrtStr(TDOMProcessingInstruction(node).Target);
   wrtChr(' ');
   wrtChr(' ');
-  wrtStr(UTF8Encode(TDOMProcessingInstruction(node).Data));
-  wrtChr('?'); wrtChr('>');
+  wrtStr(TDOMProcessingInstruction(node).Data);
+  wrtStr('?>');
   if not FInsideTextNode then wrtLineEnd;
   if not FInsideTextNode then wrtLineEnd;
 end;
 end;
 
 
@@ -351,7 +426,7 @@ procedure TXMLWriter.VisitComment(node: TDOMNode);
 begin
 begin
   if not FInsideTextNode then wrtIndent;
   if not FInsideTextNode then wrtIndent;
   wrtStr('<!--');
   wrtStr('<!--');
-  wrtStr(UTF8Encode(node.NodeValue));
+  wrtStr(node.NodeValue);
   wrtStr('-->');
   wrtStr('-->');
   if not FInsideTextNode then wrtLineEnd;
   if not FInsideTextNode then wrtLineEnd;
 end;
 end;
@@ -370,7 +445,7 @@ begin
   begin
   begin
     wrtStr(' encoding="');
     wrtStr(' encoding="');
     ConvWrite(TXMLDocument(node).Encoding, AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback);
     ConvWrite(TXMLDocument(node).Encoding, AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback);
-    wrtStr('"');
+    wrtChr('"');
   end;
   end;
   wrtStr('?>');
   wrtStr('?>');
   wrtLineEnd;
   wrtLineEnd;
@@ -385,22 +460,31 @@ begin
     wrtLineEnd;
     wrtLineEnd;
   end;
   end;
 
 
-  FIndent := '  ';
-  FIndentCount := 0;
-
   child := node.FirstChild;
   child := node.FirstChild;
   while Assigned(Child) do
   while Assigned(Child) do
   begin
   begin
     WriteNode(Child);
     WriteNode(Child);
     Child := Child.NextSibling;
     Child := Child.NextSibling;
   end;
   end;
-
-  if node=nil then ;
 end;
 end;
 
 
 procedure TXMLWriter.VisitAttribute(Node: TDOMNode);
 procedure TXMLWriter.VisitAttribute(Node: TDOMNode);
+var
+  Child: TDOMNode;
 begin
 begin
-
+  wrtChr(' ');
+  wrtStr(Node.NodeName);
+  wrtStr('="');
+  Child := Node.FirstChild;
+  while Assigned(Child) do
+  begin
+    if Child.NodeType = ENTITY_REFERENCE_NODE then
+      VisitEntityRef(Child)
+    else
+      ConvWrite(Child.NodeValue, AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback);
+    Child := Child.NextSibling;
+  end;
+  wrtChr('"');
 end;
 end;
 
 
 procedure TXMLWriter.VisitDocumentType(Node: TDOMNode);
 procedure TXMLWriter.VisitDocumentType(Node: TDOMNode);
@@ -409,8 +493,16 @@ begin
 end;
 end;
 
 
 procedure TXMLWriter.VisitFragment(Node: TDOMNode);
 procedure TXMLWriter.VisitFragment(Node: TDOMNode);
+var
+  Child: TDOMNode;
 begin
 begin
-  VisitElement(Node);
+  // Fragment itself should not be written, only its children should...
+  Child := Node.FirstChild;
+  while Assigned(Child) do
+  begin
+    WriteNode(Child);
+    Child := Child.NextSibling;
+  end;
 end;
 end;
 
 
 procedure TXMLWriter.VisitNotation(Node: TDOMNode);
 procedure TXMLWriter.VisitNotation(Node: TDOMNode);
@@ -419,31 +511,17 @@ begin
 end;
 end;
 
 
 
 
-procedure TStreamXMLWriter.WriteXML(Root: TDOMNode; AStream: TStream);
-begin
-  F:=AStream;
-  WriteNode(Root);
-end;
-
-procedure TTextXMLWriter.WriteXML(Root: TDOMNode; var AFile: Text);
-begin
-  f := @AFile;
-  WriteNode(Root);
-end;
-
 // -------------------------------------------------------------------
 // -------------------------------------------------------------------
 //   Interface implementation
 //   Interface implementation
 // -------------------------------------------------------------------
 // -------------------------------------------------------------------
 
 
 procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String);
 procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String);
-
 var
 var
   fs: TFileStream;
   fs: TFileStream;
-  
 begin
 begin
   fs := TFileStream.Create(AFileName, fmCreate);
   fs := TFileStream.Create(AFileName, fmCreate);
   try
   try
-     WriteXMLFile(doc, fs);
+    WriteXMLFile(doc, fs);
   finally
   finally
     fs.Free;
     fs.Free;
   end;
   end;
@@ -451,9 +529,9 @@ end;
 
 
 procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
 procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
 begin
 begin
-  with TTextXMLWriter.Create do
+  with TTextXMLWriter.Create(AFile) do
   try
   try
-    WriteXML(doc, AFile);
+    WriteNode(doc);
   finally
   finally
     Free;
     Free;
   end;
   end;
@@ -461,9 +539,9 @@ end;
 
 
 procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream);
 procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream);
 begin
 begin
-  with TStreamXMLWriter.Create do
+  with TStreamXMLWriter.Create(AStream) do
   try
   try
-    WriteXML(doc, AStream);
+    WriteNode(doc);
   finally
   finally
     Free;
     Free;
   end;
   end;
@@ -471,17 +549,17 @@ end;
 
 
 procedure WriteXML(Element: TDOMNode; const AFileName: String);
 procedure WriteXML(Element: TDOMNode; const AFileName: String);
 begin
 begin
-  WriteXML(TXMLDocument(Element), AFileName);
+  WriteXMLFile(TXMLDocument(Element), AFileName);
 end;
 end;
 
 
 procedure WriteXML(Element: TDOMNode; var AFile: Text);
 procedure WriteXML(Element: TDOMNode; var AFile: Text);
 begin
 begin
-  WriteXML(TXMLDocument(Element), AFile);
+  WriteXMLFile(TXMLDocument(Element), AFile);
 end;
 end;
 
 
 procedure WriteXML(Element: TDOMNode; AStream: TStream);
 procedure WriteXML(Element: TDOMNode; AStream: TStream);
 begin
 begin
-  WriteXML(TXMLDocument(Element), AStream);
+  WriteXMLFile(TXMLDocument(Element), AStream);
 end;
 end;
 
 
 
 

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