* Merging revisions 41662 from trunk:

    ------------------------------------------------------------------------
    r41662 | michael | 2019-03-09 20:46:46 +0100 (Sat, 09 Mar 2019) | 1 line
    
    * Expose TDOMWriter and TXMLWriter
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@41950 -

.gitattributes

@@ -3398,6 +3398,8 @@ packages/fcl-xml/Makefile.fpc svneol=native#text/plain
 packages/fcl-xml/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/fcl-xml/buildfclxml.lpi svneol=native#text/plain
 packages/fcl-xml/buildfclxml.pp svneol=native#text/plain
+packages/fcl-xml/examples/reducexml.lpi svneol=native#text/plain
+packages/fcl-xml/examples/reducexml.pp svneol=native#text/plain
 packages/fcl-xml/examples/test.html svneol=native#text/html
 packages/fcl-xml/examples/testhtml.pp svneol=native#text/plain
 packages/fcl-xml/fpmake.pp svneol=native#text/plain

packages/fcl-xml/examples/reducexml.lpi

@@ -0,0 +1,47 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="reducexml"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="reducexml.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="reducexml"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+</CONFIG>

packages/fcl-xml/examples/reducexml.pp

@@ -0,0 +1,37 @@
+program reducexml;
+
+{$mode objfpc}
+{$h+}
+
+uses cwstring,SysUtils,classes,DOM,xmlutils,xmlread,xmlwrite;
+
+Var
+  D : TXMLDocument;
+  S : TFileStream;
+  W : TDOMWriter;
+  FN : String;
+ 
+
+begin
+  if paramCount=0 then
+    begin
+    Writeln('Usage : reducexml infile [outfile]');
+    halt(1);
+    end;
+  ReadXMLFile(D,ParamStr(1));
+  FN:=ParamStr(2);
+  if FN='' then
+    FN:=ChangeFileExt(ParamStr(1),'-new.xml');
+  W:=nil;  
+  S:=TFileStream.Create(FN,fmCreate);
+  try
+    W:=TDOMWriter.Create(S,D);
+    W.IndentSize:=1;
+//    W.Canonical:=True;
+    W.UseTab:=True;
+    W.WriteNode(D);
+  Finally
+    W.Free;
+    S.Free;
+  end;
+end.

packages/fcl-xml/src/xmlwrite.pp

@@ -22,33 +22,11 @@ unit XMLWrite;
 
 interface
 
-uses Classes, DOM;
+uses Classes, DOM, xmlutils;
 
-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(Element: TDOMNode; const AFileName: String); overload;
-procedure WriteXML(Element: TDOMNode; var AFile: Text); overload;
-procedure WriteXML(Element: TDOMNode; AStream: TStream); overload;
-
-
-// ===================================================================
-
-implementation
-
-uses SysUtils, xmlutils;
-
-type
-  TXMLWriter = class;
-  TSpecialCharCallback = procedure(Sender: TXMLWriter; const s: DOMString;
-    var idx: Integer);
-
-  PAttrFixup = ^TAttrFixup;
-  TAttrFixup = record
-    Attr: TDOMNode;
-    Prefix: PHashItem;
-  end;
+Type
+  TXMLWriter = Class;
+  TSpecialCharCallback = procedure(Sender: TXMLWriter; const s: DOMString; var idx: Integer);
 
   TNodeInfo = record
     Name: XMLString;
@@ -56,8 +34,11 @@ type
 
   TNodeInfoArray = array of TNodeInfo;
 
+  { TXMLWriter }
+
   TXMLWriter = class(TObject)
   private
+    FIndentSize: Integer;
     FStream: TStream;
     FInsideTextNode: Boolean;
     FCanonical: Boolean;
@@ -72,8 +53,11 @@ type
     FScratch: TFPList;
     FNSDefs: TFPList;
     FNodes: TNodeInfoArray;
-    procedure WriteXMLDecl(const aVersion, aEncoding: XMLString;
-      aStandalone: Integer);
+    FUseTab: Boolean;
+    procedure SetCanonical(AValue: Boolean);
+    procedure SetIndentSize(AValue: Integer);
+    procedure SetLineBreak(AValue: XMLString);
+    procedure SetUseTab(AValue: Boolean);
     procedure wrtChars(Src: PWideChar; Length: Integer);
     procedure IncNesting;
     procedure DecNesting; {$IFDEF HAS_INLINE} inline; {$ENDIF}
@@ -81,33 +65,72 @@ type
     procedure wrtChr(c: WideChar); {$IFDEF HAS_INLINE} inline; {$ENDIF}
     procedure wrtIndent(EndElement: Boolean = False);
     procedure wrtQuotedLiteral(const ws: XMLString);
-    procedure ConvWrite(const s: XMLString; const SpecialChars: TSetOfChar;
-      const SpecialCharCallback: TSpecialCharCallback);
+    procedure ConvWrite(const s: XMLString; const SpecialChars: TSetOfChar; const SpecialCharCallback: TSpecialCharCallback);
     procedure WriteNSDef(B: TBinding);
-    procedure NamespaceFixup(Element: TDOMElement);
   protected
-    procedure WriteNode(Node: TDOMNode);
+    Procedure InitIndentLineBreak;
+    // Canonical does not yet quite work
+    Property Canonical : Boolean Read FCanonical Write SetCanonical;
+  public
+    constructor Create(AStream: TStream; ANameTable: THashTable);
+    destructor Destroy; override;
+    procedure WriteXMLDecl(const aVersion, aEncoding: XMLString;   aStandalone: Integer); virtual;
+    procedure WriteStartElement(const Name: XMLString); virtual;
+    procedure WriteEndElement(shortForm: Boolean); virtual;
+    procedure WriteProcessingInstruction(const Target, Data: XMLString); virtual;
+    procedure WriteEntityRef(const Name: XMLString); virtual;
+    procedure WriteAttributeString(const Name, Value: XMLString); virtual;
+    procedure WriteDocType(const Name, PubId, SysId, Subset: XMLString); virtual;
+    procedure WriteString(const Text: XMLString); virtual;
+    procedure WriteCDATA(const Text: XMLString); virtual;
+    procedure WriteComment(const Text: XMLString); virtual;
+    // Only set these before writing !
+    // Use tab character instead of space.
+    Property UseTab : Boolean Read FUseTab Write SetUseTab;
+    // Indent size in number of characters
+    Property IndentSize : Integer Read FIndentSize Write SetIndentSize;
+    // Default is system setting. Ignored when Canonical = True.
+    Property LineBreak : XMLString Read FLineBreak Write SetLineBreak;
+  end;
+
+  { TDOMWriter }
+
+  TDOMWriter = class(TXMLWriter)
+  Protected
+    procedure NamespaceFixup(Element: TDOMElement);
     procedure VisitDocument(Node: TDOMNode);
     procedure VisitDocument_Canonical(Node: TDOMNode);
     procedure VisitElement(Node: TDOMNode);
-    procedure WriteString(const Text: XMLString);
-    procedure WriteCDATA(const Text: XMLString);
-    procedure WriteComment(const Text: XMLString);
     procedure VisitFragment(Node: TDOMNode);
     procedure VisitAttribute(Node: TDOMNode);
     procedure VisitEntityRef(Node: TDOMNode);
     procedure VisitDocumentType(Node: TDOMNode);
     procedure VisitPI(Node: TDOMNode);
+  Public
+    constructor Create(AStream: TStream; aNode : TDOMNode);
+    procedure WriteNode(Node: TDOMNode);
+  end;
 
-    procedure WriteStartElement(const Name: XMLString);
-    procedure WriteEndElement(shortForm: Boolean);
-    procedure WriteProcessingInstruction(const Target, Data: XMLString);
-    procedure WriteEntityRef(const Name: XMLString);
-    procedure WriteAttributeString(const Name, Value: XMLString);
-    procedure WriteDocType(const Name, PubId, SysId, Subset: XMLString);
-  public
-    constructor Create(AStream: TStream; ANameTable: THashTable);
-    destructor Destroy; override;
+
+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(Element: TDOMNode; const AFileName: String); overload;
+procedure WriteXML(Element: TDOMNode; var AFile: Text); overload;
+procedure WriteXML(Element: TDOMNode; AStream: TStream); overload;
+
+// ===================================================================
+
+implementation
+
+uses SysUtils;
+
+type
+  PAttrFixup = ^TAttrFixup;
+  TAttrFixup = record
+    Attr: TDOMNode;
+    Prefix: PHashItem;
   end;
 
   TTextStream = class(TStream)
@@ -142,7 +165,7 @@ begin
 end;
 
 { ---------------------------------------------------------------------
-    TXMLWriter
+    Auxiliary routines
   ---------------------------------------------------------------------}
 
 const
@@ -154,10 +177,128 @@ const
   AmpStr = '&';
   ltStr = '<';
   gtStr = '>';
+  IndentChars : Array[Boolean] of char = (' ',#9);
 
-constructor TXMLWriter.Create(AStream: TStream; ANameTable: THashTable);
+procedure AttrSpecialCharCallback(Sender: TXMLWriter; const s: DOMString;
+  var idx: Integer);
+begin
+  case s[idx] of
+    '"': Sender.wrtStr(QuotStr);
+    '&': Sender.wrtStr(AmpStr);
+    '<': Sender.wrtStr(ltStr);
+    // This is *only* to interoperate with broken parsers out there,
+    // Delphi ClientDataset parser being one of them.
+    '>': if not Sender.FCanonical then
+           Sender.wrtStr(gtStr)
+         else
+           Sender.wrtChr('>');
+    // Escape whitespace using CharRefs to be consistent with W3 spec § 3.3.3
+    #9: Sender.wrtStr('&#x9;');
+    #10: Sender.wrtStr('&#xA;');
+    #13: Sender.wrtStr('&#xD;');
+  else
+    raise EConvertError.Create('Illegal character');
+  end;
+end;
+
+procedure TextnodeNormalCallback(Sender: TXMLWriter; const s: DOMString;
+  var idx: Integer);
+begin
+  case s[idx] of
+    '<': Sender.wrtStr(ltStr);
+    '>': Sender.wrtStr(gtStr); // Required only in ']]>' literal, otherwise optional
+    '&': Sender.wrtStr(AmpStr);
+    #13:
+      begin
+        // We normalize #13#10 and #13 to FLineBreak, going somewhat
+        // beyond the specs here, see issue #13879.
+        Sender.wrtStr(Sender.FLineBreak);
+        if (idx < Length(s)) and (s[idx+1] = #10) then
+          Inc(idx);
+      end;
+    #10: Sender.wrtStr(Sender.FLineBreak);
+  else
+    raise EConvertError.Create('Illegal character');
+  end;
+end;
+
+procedure TextnodeCanonicalCallback(Sender: TXMLWriter; const s: DOMString;
+  var idx: Integer);
+begin
+  case s[idx] of
+    '<': Sender.wrtStr(ltStr);
+    '>': Sender.wrtStr(gtStr);
+    '&': Sender.wrtStr(AmpStr);
+    #13: Sender.wrtStr('&#xD;');
+    #10: Sender.wrtChr(#10);
+  else
+    raise EConvertError.Create('Illegal character');
+  end;
+end;
+
+procedure CDSectSpecialCharCallback(Sender: TXMLWriter; const s: DOMString;
+  var idx: Integer);
+begin
+  if s[idx]=']' then
+  begin
+    if (idx <= Length(s)-2) and (s[idx+1] = ']') and (s[idx+2] = '>') then
+    begin
+      Sender.wrtStr(']]]]><![CDATA[>');
+      Inc(idx, 2);
+      // TODO: emit warning 'cdata-section-splitted'
+    end
+    else
+      Sender.wrtChr(']');
+  end  
+  else
+    raise EConvertError.Create('Illegal character');
+end;
+
+// clone of system.FPC_WIDESTR_COMPARE which cannot be called directly
+function Compare(const s1, s2: DOMString): integer;
 var
-  I: Integer;
+  maxi, temp: integer;
+begin
+  Result := 0;
+  if pointer(S1) = pointer(S2) then
+    exit;
+  maxi := Length(S1);
+  temp := Length(S2);
+  if maxi > temp then
+    maxi := temp;
+  Result := CompareWord(S1[1], S2[1], maxi);
+  if Result = 0 then
+    Result := Length(S1)-Length(S2);
+end;
+
+function SortNSDefs(Item1, Item2: Pointer): Integer;
+begin
+  Result := Compare(TBinding(Item1).Prefix^.Key, TBinding(Item2).Prefix^.Key);
+end;
+
+function SortAtts(Item1, Item2: Pointer): Integer;
+var
+  p1: PAttrFixup absolute Item1;
+  p2: PAttrFixup absolute Item2;
+begin
+  Result := Compare(p1^.Attr.namespaceURI, p2^.Attr.namespaceURI);
+  if Result = 0 then
+    Result := Compare(p1^.Attr.localName, p2^.Attr.localName);
+end;
+
+const
+  TextnodeCallbacks: array[boolean] of TSpecialCharCallback = (
+    @TextnodeNormalCallback,
+    @TextnodeCanonicalCallback
+  );
+
+{ ---------------------------------------------------------------------
+    TXMLWriter
+  ---------------------------------------------------------------------}
+
+
+constructor TXMLWriter.Create(AStream: TStream; ANameTable: THashTable);
+
 begin
   inherited Create;
   FStream := AStream;
@@ -165,21 +306,11 @@ begin
   FBuffer := AllocMem(512+32);
   FBufPos := FBuffer;
   FCapacity := 512;
-  // Later on, this may be put under user control
-  // for now, take OS setting
-  if FCanonical then
-    FLineBreak := #10
-  else
-    FLineBreak := sLineBreak;
-  // Initialize Indent string
-  // TODO: this must be done in setter of FLineBreak
-  SetLength(FIndent, 100);
-  FIndent[1] := FLineBreak[1];
-  if Length(FLineBreak) > 1 then
-    FIndent[2] := FLineBreak[2]
-  else
-    FIndent[2] := ' ';
-  for I := 3 to 100 do FIndent[I] := ' ';
+  FCanonical:=False;
+  FIndentSize:=2;
+  FUseTab:=False;
+  FLineBreak := sLineBreak;
+  InitIndentLineBreak;
   FNesting := 0;
   SetLength(FNodes, 16);
   FNSHelper := TNSSupport.Create(ANameTable);
@@ -277,8 +408,14 @@ begin
 end;
 
 procedure TXMLWriter.wrtIndent(EndElement: Boolean);
+
+Var
+  L : integer;
+
 begin
-  wrtChars(PWideChar(FIndent), (FNesting-ord(EndElement))*2+Length(FLineBreak));
+  L:=(FNesting-ord(EndElement))*IndentSize+Length(FLineBreak);
+  if (L>0) then
+    wrtChars(PWideChar(FIndent), L);
 end;
 
 procedure TXMLWriter.IncNesting;
@@ -288,14 +425,14 @@ begin
   Inc(FNesting);
   if FNesting >= Length(FNodes) then
     SetLength(FNodes, FNesting+8);
-  if (Length(FIndent)-Length(FLineBreak)) < 2 * FNesting then
-  begin
+  if (Length(FIndent)-Length(FLineBreak)) < IndentSize * FNesting then
+    begin
     OldLen := Length(FIndent);
-    NewLen := 4 * FNesting;
+    NewLen := (IndentSize*2) * FNesting;
     SetLength(FIndent, NewLen);
     for I := OldLen to NewLen do
-      FIndent[I] := ' ';
-  end;
+      FIndent[I] := IndentChars[UseTab];
+    end;
 end;
 
 procedure TXMLWriter.DecNesting; { inline }
@@ -324,86 +461,6 @@ begin
     wrtChars(@s[StartPos], EndPos - StartPos);
 end;
 
-procedure AttrSpecialCharCallback(Sender: TXMLWriter; const s: DOMString;
-  var idx: Integer);
-begin
-  case s[idx] of
-    '"': Sender.wrtStr(QuotStr);
-    '&': Sender.wrtStr(AmpStr);
-    '<': Sender.wrtStr(ltStr);
-    // This is *only* to interoperate with broken parsers out there,
-    // Delphi ClientDataset parser being one of them.
-    '>': if not Sender.FCanonical then
-           Sender.wrtStr(gtStr)
-         else
-           Sender.wrtChr('>');
-    // Escape whitespace using CharRefs to be consistent with W3 spec § 3.3.3
-    #9: Sender.wrtStr('&#x9;');
-    #10: Sender.wrtStr('&#xA;');
-    #13: Sender.wrtStr('&#xD;');
-  else
-    raise EConvertError.Create('Illegal character');
-  end;
-end;
-
-procedure TextnodeNormalCallback(Sender: TXMLWriter; const s: DOMString;
-  var idx: Integer);
-begin
-  case s[idx] of
-    '<': Sender.wrtStr(ltStr);
-    '>': Sender.wrtStr(gtStr); // Required only in ']]>' literal, otherwise optional
-    '&': Sender.wrtStr(AmpStr);
-    #13:
-      begin
-        // We normalize #13#10 and #13 to FLineBreak, going somewhat
-        // beyond the specs here, see issue #13879.
-        Sender.wrtStr(Sender.FLineBreak);
-        if (idx < Length(s)) and (s[idx+1] = #10) then
-          Inc(idx);
-      end;
-    #10: Sender.wrtStr(Sender.FLineBreak);
-  else
-    raise EConvertError.Create('Illegal character');
-  end;
-end;
-
-procedure TextnodeCanonicalCallback(Sender: TXMLWriter; const s: DOMString;
-  var idx: Integer);
-begin
-  case s[idx] of
-    '<': Sender.wrtStr(ltStr);
-    '>': Sender.wrtStr(gtStr);
-    '&': Sender.wrtStr(AmpStr);
-    #13: Sender.wrtStr('&#xD;');
-    #10: Sender.wrtChr(#10);
-  else
-    raise EConvertError.Create('Illegal character');
-  end;
-end;
-
-procedure CDSectSpecialCharCallback(Sender: TXMLWriter; const s: DOMString;
-  var idx: Integer);
-begin
-  if s[idx]=']' then
-  begin
-    if (idx <= Length(s)-2) and (s[idx+1] = ']') and (s[idx+2] = '>') then
-    begin
-      Sender.wrtStr(']]]]><![CDATA[>');
-      Inc(idx, 2);
-      // TODO: emit warning 'cdata-section-splitted'
-    end
-    else
-      Sender.wrtChr(']');
-  end  
-  else
-    raise EConvertError.Create('Illegal character');
-end;
-
-const
-  TextnodeCallbacks: array[boolean] of TSpecialCharCallback = (
-    @TextnodeNormalCallback,
-    @TextnodeCanonicalCallback
-  );
 
 procedure TXMLWriter.wrtQuotedLiteral(const ws: XMLString);
 var
@@ -420,26 +477,6 @@ begin
   wrtChr(Quote);
 end;
 
-procedure TXMLWriter.WriteNode(node: TDOMNode);
-begin
-  case node.NodeType of
-    ELEMENT_NODE:                VisitElement(node);
-    ATTRIBUTE_NODE:              VisitAttribute(node);
-    TEXT_NODE:                   WriteString(TDOMCharacterData(node).Data);
-    CDATA_SECTION_NODE:          WriteCDATA(TDOMCharacterData(node).Data);
-    ENTITY_REFERENCE_NODE:       VisitEntityRef(node);
-    PROCESSING_INSTRUCTION_NODE: VisitPI(node);
-    COMMENT_NODE:                WriteComment(TDOMCharacterData(node).Data);
-    DOCUMENT_NODE:
-      if FCanonical then
-        VisitDocument_Canonical(node)
-      else
-        VisitDocument(node);
-    DOCUMENT_TYPE_NODE:          VisitDocumentType(node);
-    ENTITY_NODE,
-    DOCUMENT_FRAGMENT_NODE:      VisitFragment(node);
-  end;
-end;
 
 procedure TXMLWriter.WriteNSDef(B: TBinding);
 begin
@@ -455,169 +492,31 @@ begin
   wrtChr('"');
 end;
 
-// clone of system.FPC_WIDESTR_COMPARE which cannot be called directly
-function Compare(const s1, s2: DOMString): integer;
-var
-  maxi, temp: integer;
-begin
-  Result := 0;
-  if pointer(S1) = pointer(S2) then
-    exit;
-  maxi := Length(S1);
-  temp := Length(S2);
-  if maxi > temp then
-    maxi := temp;
-  Result := CompareWord(S1[1], S2[1], maxi);
-  if Result = 0 then
-    Result := Length(S1)-Length(S2);
-end;
-
-function SortNSDefs(Item1, Item2: Pointer): Integer;
-begin
-  Result := Compare(TBinding(Item1).Prefix^.Key, TBinding(Item2).Prefix^.Key);
-end;
-
-function SortAtts(Item1, Item2: Pointer): Integer;
-var
-  p1: PAttrFixup absolute Item1;
-  p2: PAttrFixup absolute Item2;
-begin
-  Result := Compare(p1^.Attr.namespaceURI, p2^.Attr.namespaceURI);
-  if Result = 0 then
-    Result := Compare(p1^.Attr.localName, p2^.Attr.localName);
-end;
-
-procedure TXMLWriter.NamespaceFixup(Element: TDOMElement);
-var
-  B: TBinding;
-  i, j: Integer;
-  node: TDOMNode;
-  s: DOMString;
-  action: TAttributeAction;
-  p: PAttrFixup;
-begin
-  FScratch.Count := 0;
-  FNSDefs.Count := 0;
-  if Element.hasAttributes then
-  begin
-    j := 0;
-    for i := 0 to Element.Attributes.Length-1 do
-    begin
-      node := Element.Attributes[i];
-      if TDOMNode_NS(node).NSI.NSIndex = 2 then
-      begin
-        if TDOMNode_NS(node).NSI.PrefixLen = 0 then
-          s := ''
-        else
-          s := node.localName;
-        FNSHelper.DefineBinding(s, node.nodeValue, B);
-        if Assigned(B) then  // drop redundant namespace declarations
-          FNSDefs.Add(B);
-      end
-      else if FCanonical or TDOMAttr(node).Specified then
-      begin
-        // obtain a TAttrFixup record (allocate if needed)
-        if j >= FAttrFixups.Count then
-        begin
-          New(p);
-          FAttrFixups.Add(p);
-        end
-        else
-          p := PAttrFixup(FAttrFixups.List^[j]);
-        // add it to the working list
-        p^.Attr := node;
-        p^.Prefix := nil;
-        FScratch.Add(p);
-        Inc(j);
-      end;
-    end;
-  end;
-
-  FNSHelper.DefineBinding(Element.Prefix, Element.namespaceURI, B);
-  if Assigned(B) then
-    FNSDefs.Add(B);
-
-  for i := 0 to FScratch.Count-1 do
-  begin
-    node := PAttrFixup(FScratch.List^[i])^.Attr;
-    action := FNSHelper.CheckAttribute(node.Prefix, node.namespaceURI, B);
-    if action = aaBoth then
-      FNSDefs.Add(B);
-
-    if action in [aaPrefix, aaBoth] then
-      PAttrFixup(FScratch.List^[i])^.Prefix := B.Prefix;
-  end;
-
-  if FCanonical then
-  begin
-    FNSDefs.Sort(@SortNSDefs);
-    FScratch.Sort(@SortAtts);
-  end;
-
-  // now, at last, dump all this stuff.
-  for i := 0 to FNSDefs.Count-1 do
-    WriteNSDef(TBinding(FNSDefs.List^[I]));
-
-  for i := 0 to FScratch.Count-1 do
-  begin
-    wrtChr(' ');
-    with PAttrFixup(FScratch.List^[I])^ do
-    begin
-      if Assigned(Prefix) then
-      begin
-        wrtStr(Prefix^.Key);
-        wrtChr(':');
-        wrtStr(Attr.localName);
-      end
-      else
-        wrtStr(Attr.nodeName);
-
-      wrtChars('="', 2);
-      // TODO: not correct w.r.t. entities
-      ConvWrite(attr.nodeValue, AttrSpecialChars, @AttrSpecialCharCallback);
-      wrtChr('"');
-    end;
-  end;
-end;
-
-procedure TXMLWriter.VisitElement(node: TDOMNode);
-var
-  i: Integer;
-  child: TDOMNode;
-  SavedInsideTextNode: Boolean;
-begin
-  WriteStartElement(TDOMElement(node).TagName);
-
-  if nfLevel2 in node.Flags then
-    NamespaceFixup(TDOMElement(node))
-  else if node.HasAttributes then
-    for i := 0 to node.Attributes.Length - 1 do
-    begin
-      child := node.Attributes.Item[i];
-      if FCanonical or TDOMAttr(child).Specified then
-        VisitAttribute(child);
-    end;
-  Child := node.FirstChild;
-  if Child = nil then
-    WriteEndElement(True)
-  else
-  begin
-    // TODO: presence of zero-length textnodes triggers the indenting logic,
-    // while they should be ignored altogeter.
-    SavedInsideTextNode := FInsideTextNode;
-    wrtChr('>');
-    FInsideTextNode := FCanonical or (Child.NodeType in [TEXT_NODE, CDATA_SECTION_NODE]);
-    repeat
-      WriteNode(Child);
-      Child := Child.NextSibling;
-    until Child = nil;
-    if not (node.LastChild.NodeType in [TEXT_NODE, CDATA_SECTION_NODE]) then
-      wrtIndent(True);
-    FInsideTextNode := SavedInsideTextNode;
-    writeEndElement(False);
-  end;
+
+procedure TXMLWriter.InitIndentLineBreak;
+
+Var
+  I : Integer;
+
+begin
+  if FCanonical then
+    FLineBreak := #10;
+  // Initialize Indent string
+  SetLength(FIndent, 100);
+  I:=1;
+  While I<=Length(FLineBreak) do
+    begin
+    FIndent[I] := FLineBreak[I];
+    Inc(I);
+    end;
+  While I<=Length(Findent) do
+    begin
+    FIndent[I]:=IndentChars[UseTab];
+    Inc(I);
+    end;
 end;
 
+
 procedure TXMLWriter.WriteStartElement(const Name: XMLString);
 begin
   if not FInsideTextNode then
@@ -670,10 +569,6 @@ begin
   wrtChr(';');
 end;
 
-procedure TXMLWriter.VisitEntityRef(node: TDOMNode);
-begin
-  WriteEntityRef(node.NodeName);
-end;
 
 procedure TXMLWriter.WriteProcessingInstruction(const Target, Data: XMLString);
 begin
@@ -689,10 +584,6 @@ begin
   wrtStr('?>');
 end;
 
-procedure TXMLWriter.VisitPI(node: TDOMNode);
-begin
-  WriteProcessingInstruction(TDOMProcessingInstruction(node).Target, TDOMProcessingInstruction(node).Data);
-end;
 
 procedure TXMLWriter.WriteComment(const Text: XMLString);
 begin
@@ -729,7 +620,121 @@ begin
   wrtStr('?>');
 end;
 
-procedure TXMLWriter.VisitDocument(node: TDOMNode);
+procedure TXMLWriter.SetCanonical(AValue: Boolean);
+begin
+  if FCanonical=AValue then Exit;
+  FCanonical:=AValue;
+  InitIndentLineBreak;
+end;
+
+procedure TXMLWriter.SetIndentSize(AValue: Integer);
+begin
+  if FIndentSize=AValue then Exit;
+  FIndentSize:=AValue;
+  InitIndentLineBreak;
+end;
+
+procedure TXMLWriter.SetLineBreak(AValue: XMLString);
+begin
+  if FLineBreak=AValue then Exit;
+  FLineBreak:=AValue;
+  InitIndentLineBreak;
+end;
+
+procedure TXMLWriter.SetUseTab(AValue: Boolean);
+begin
+  if FUseTab=AValue then Exit;
+  FUseTab:=AValue;
+  InitIndentLineBreak;
+end;
+
+{ ---------------------------------------------------------------------
+  TDOMWriter
+  ---------------------------------------------------------------------}
+
+procedure TDOMWriter.WriteNode(node: TDOMNode);
+begin
+  case node.NodeType of
+    ELEMENT_NODE:                VisitElement(node);
+    ATTRIBUTE_NODE:              VisitAttribute(node);
+    TEXT_NODE:                   WriteString(TDOMCharacterData(node).Data);
+    CDATA_SECTION_NODE:          WriteCDATA(TDOMCharacterData(node).Data);
+    ENTITY_REFERENCE_NODE:       VisitEntityRef(node);
+    PROCESSING_INSTRUCTION_NODE: VisitPI(node);
+    COMMENT_NODE:                WriteComment(TDOMCharacterData(node).Data);
+    DOCUMENT_NODE:
+      if FCanonical then
+        VisitDocument_Canonical(node)
+      else
+        VisitDocument(node);
+    DOCUMENT_TYPE_NODE:          VisitDocumentType(node);
+    ENTITY_NODE,
+    DOCUMENT_FRAGMENT_NODE:      VisitFragment(node);
+  end;
+end;
+
+procedure TDOMWriter.VisitElement(node: TDOMNode);
+var
+  i: Integer;
+  child: TDOMNode;
+  SavedInsideTextNode: Boolean;
+begin
+  WriteStartElement(TDOMElement(node).TagName);
+
+  if nfLevel2 in node.Flags then
+    NamespaceFixup(TDOMElement(node))
+  else if node.HasAttributes then
+    for i := 0 to node.Attributes.Length - 1 do
+    begin
+      child := node.Attributes.Item[i];
+      if FCanonical or TDOMAttr(child).Specified then
+        VisitAttribute(child);
+    end;
+  Child := node.FirstChild;
+  if Child = nil then
+    WriteEndElement(True)
+  else
+  begin
+    // TODO: presence of zero-length textnodes triggers the indenting logic,
+    // while they should be ignored altogeter.
+    SavedInsideTextNode := FInsideTextNode;
+    wrtChr('>');
+    FInsideTextNode := FCanonical or (Child.NodeType in [TEXT_NODE, CDATA_SECTION_NODE]);
+    repeat
+      WriteNode(Child);
+      Child := Child.NextSibling;
+    until Child = nil;
+    if not (node.LastChild.NodeType in [TEXT_NODE, CDATA_SECTION_NODE]) then
+      wrtIndent(True);
+    FInsideTextNode := SavedInsideTextNode;
+    writeEndElement(False);
+  end;
+end;
+
+procedure TDOMWriter.VisitEntityRef(node: TDOMNode);
+begin
+  WriteEntityRef(node.NodeName);
+end;
+
+procedure TDOMWriter.VisitPI(node: TDOMNode);
+begin
+  WriteProcessingInstruction(TDOMProcessingInstruction(node).Target, TDOMProcessingInstruction(node).Data);
+end;
+
+constructor TDOMWriter.Create(AStream: TStream; aNode: TDOMNode);
+
+var
+  doc: TDOMDocument;
+begin
+  if aNode.NodeType = DOCUMENT_NODE then
+    doc := TDOMDocument(aNode)
+  else
+    doc := aNode.OwnerDocument;
+  Inherited Create(aStream,Doc.Names);
+end;
+
+
+procedure TDOMWriter.VisitDocument(node: TDOMNode);
 var
   child: TDOMNode;
 begin
@@ -760,7 +765,7 @@ begin
   wrtStr(FLineBreak);
 end;
 
-procedure TXMLWriter.VisitDocument_Canonical(Node: TDOMNode);
+procedure TDOMWriter.VisitDocument_Canonical(Node: TDOMNode);
 var
   child, root: TDOMNode;
 begin
@@ -799,32 +804,6 @@ begin
   wrtChr('"');
 end;
 
-procedure TXMLWriter.VisitAttribute(Node: TDOMNode);
-var
-  Child: TDOMNode;
-begin
-  wrtChr(' ');
-  wrtStr(TDOMAttr(Node).Name);
-  wrtChars('="', 2);
-  Child := Node.FirstChild;
-  while Assigned(Child) do
-  begin
-    case Child.NodeType of
-      ENTITY_REFERENCE_NODE:
-        VisitEntityRef(Child);
-      TEXT_NODE:
-        ConvWrite(TDOMCharacterData(Child).Data, AttrSpecialChars, @AttrSpecialCharCallback);
-    end;
-    Child := Child.NextSibling;
-  end;
-  wrtChr('"');
-end;
-
-procedure TXMLWriter.VisitDocumentType(Node: TDOMNode);
-begin
-  WriteDocType(Node.NodeName, TDOMDocumentType(Node).PublicID, TDOMDocumentType(Node).SystemID,
-               TDOMDocumentType(Node).InternalSubset);
-end;
 
 procedure TXMLWriter.WriteDocType(const Name, PubId, SysId, Subset: XMLString);
 begin
@@ -853,7 +832,7 @@ begin
   wrtChr('>');
 end;
 
-procedure TXMLWriter.VisitFragment(Node: TDOMNode);
+procedure TDOMWriter.VisitFragment(Node: TDOMNode);
 var
   Child: TDOMNode;
 begin
@@ -867,6 +846,126 @@ begin
   end;
 end;
 
+procedure TDOMWriter.VisitAttribute(Node: TDOMNode);
+var
+  Child: TDOMNode;
+begin
+  wrtChr(' ');
+  wrtStr(TDOMAttr(Node).Name);
+  wrtChars('="', 2);
+  Child := Node.FirstChild;
+  while Assigned(Child) do
+  begin
+    case Child.NodeType of
+      ENTITY_REFERENCE_NODE:
+        VisitEntityRef(Child);
+      TEXT_NODE:
+        ConvWrite(TDOMCharacterData(Child).Data, AttrSpecialChars, @AttrSpecialCharCallback);
+    end;
+    Child := Child.NextSibling;
+  end;
+  wrtChr('"');
+end;
+
+procedure TDOMWriter.VisitDocumentType(Node: TDOMNode);
+begin
+  WriteDocType(Node.NodeName, TDOMDocumentType(Node).PublicID, TDOMDocumentType(Node).SystemID,
+               TDOMDocumentType(Node).InternalSubset);
+end;
+
+procedure TDOMWriter.NamespaceFixup(Element: TDOMElement);
+var
+  B: TBinding;
+  i, j: Integer;
+  node: TDOMNode;
+  s: DOMString;
+  action: TAttributeAction;
+  p: PAttrFixup;
+begin
+  FScratch.Count := 0;
+  FNSDefs.Count := 0;
+  if Element.hasAttributes then
+  begin
+    j := 0;
+    for i := 0 to Element.Attributes.Length-1 do
+    begin
+      node := Element.Attributes[i];
+      if TDOMNode_NS(node).NSI.NSIndex = 2 then
+      begin
+        if TDOMNode_NS(node).NSI.PrefixLen = 0 then
+          s := ''
+        else
+          s := node.localName;
+        FNSHelper.DefineBinding(s, node.nodeValue, B);
+        if Assigned(B) then  // drop redundant namespace declarations
+          FNSDefs.Add(B);
+      end
+      else if FCanonical or TDOMAttr(node).Specified then
+      begin
+        // obtain a TAttrFixup record (allocate if needed)
+        if j >= FAttrFixups.Count then
+        begin
+          New(p);
+          FAttrFixups.Add(p);
+        end
+        else
+          p := PAttrFixup(FAttrFixups.List^[j]);
+        // add it to the working list
+        p^.Attr := node;
+        p^.Prefix := nil;
+        FScratch.Add(p);
+        Inc(j);
+      end;
+    end;
+  end;
+
+  FNSHelper.DefineBinding(Element.Prefix, Element.namespaceURI, B);
+  if Assigned(B) then
+    FNSDefs.Add(B);
+
+  for i := 0 to FScratch.Count-1 do
+  begin
+    node := PAttrFixup(FScratch.List^[i])^.Attr;
+    action := FNSHelper.CheckAttribute(node.Prefix, node.namespaceURI, B);
+    if action = aaBoth then
+      FNSDefs.Add(B);
+
+    if action in [aaPrefix, aaBoth] then
+      PAttrFixup(FScratch.List^[i])^.Prefix := B.Prefix;
+  end;
+
+  if FCanonical then
+  begin
+    FNSDefs.Sort(@SortNSDefs);
+    FScratch.Sort(@SortAtts);
+  end;
+
+  // now, at last, dump all this stuff.
+  for i := 0 to FNSDefs.Count-1 do
+    WriteNSDef(TBinding(FNSDefs.List^[I]));
+
+  for i := 0 to FScratch.Count-1 do
+  begin
+    wrtChr(' ');
+    with PAttrFixup(FScratch.List^[I])^ do
+    begin
+      if Assigned(Prefix) then
+      begin
+        wrtStr(Prefix^.Key);
+        wrtChr(':');
+        wrtStr(Attr.localName);
+      end
+      else
+        wrtStr(Attr.nodeName);
+
+      wrtChars('="', 2);
+      // TODO: not correct w.r.t. entities
+      ConvWrite(attr.nodeValue, AttrSpecialChars, @AttrSpecialCharCallback);
+      wrtChr('"');
+    end;
+  end;
+end;
+
 
 // -------------------------------------------------------------------
 //   Interface implementation
@@ -900,36 +999,23 @@ begin
 end;
 
 procedure WriteXML(Element: TDOMNode; var AFile: Text);
+
 var
-  s: TStream;
-  doc: TDOMDocument;
+  S : TStream;
+
 begin
-  if Element.NodeType = DOCUMENT_NODE then
-    doc := TDOMDocument(Element)
-  else
-    doc := Element.OwnerDocument;
   s := TTextStream.Create(AFile);
   try
-    with TXMLWriter.Create(s, doc.Names) do
-    try
-      WriteNode(Element);
-    finally
-      Free;
-    end;
+    WriteXML(Element,S);
   finally
     s.Free;
   end;
 end;
 
 procedure WriteXML(Element: TDOMNode; AStream: TStream);
-var
-  doc: TDOMDocument;
+
 begin
-  if Element.NodeType = DOCUMENT_NODE then
-    doc := TDOMDocument(Element)
-  else
-    doc := Element.OwnerDocument;
-  with TXMLWriter.Create(AStream, doc.Names) do
+  with TDOMWriter.Create(AStream, Element) do
   try
     WriteNode(Element);
   finally