+ Initial implementation by Sebastian Guenther

fcl/xml/Makefile.inc

@@ -0,0 +1,4 @@
+#
+# This makefile sets some needed variable, common to all targets
+#
+XMLUNITS=dom xmlread xmlwrite xmlcfg

fcl/xml/dom.pp

@@ -0,0 +1,1227 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1998 (c) 1999 Sebastian Günther ([email protected])
+
+    Implementation of DOM document class
+    
+    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.
+
+ **********************************************************************}
+
+{
+ more or less DOM conformant class library for FreePascal
+}
+
+{$MODE objfpc}
+{$H+}
+
+unit DOM;
+
+interface
+
+uses sysutils, classes;
+
+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
+// -------------------------------------------------------
+
+  DOMString = String;  // *** should be WideString  /sg
+
+
+// -------------------------------------------------------
+//   DOMException
+// -------------------------------------------------------
+
+const
+  INDEX_SIZE_ERR              = 1;
+  DOMSTRING_SIZE_ERR          = 2;
+  HIERARCHY_REQUEST_ERR       = 3;
+  WRONG_DOCUMENT_ERR          = 4;
+  INVALID_CHARACTER_ERR       = 5;
+  NO_DATA_ALLOWED_ERR         = 6;
+  NO_MODIFICATION_ALLOWED_ERR = 7;
+  NOT_FOUND_ERR               = 8;
+  NOT_SUPPORTED_ERR           = 9;
+  INUSE_ATTRIBUTE_ERR         = 10;
+
+type
+  EDOMError = class(Exception)
+  protected
+    constructor Create(ACode: Integer; const ASituation: String);
+  public
+    Code: Integer;
+  end;
+
+  EDOMIndexSize = class(EDOMError)
+  public
+    constructor Create(const ASituation: String);
+  end;
+
+  EDOMHierarchyRequest = class(EDOMError)
+  public
+    constructor Create(const ASituation: String);
+  end;
+
+  EDOMWrongDocument = class(EDOMError)
+  public
+    constructor Create(const ASituation: String);
+  end;
+
+  EDOMNotFound = class(EDOMError)
+  public
+    constructor Create(const ASituation: String);
+  end;
+
+  EDOMNotSupported = class(EDOMError)
+  public
+    constructor Create(const ASituation: String);
+  end;
+
+  EDOMInUseAttribute = class(EDOMError)
+  public
+    constructor Create(const ASituation: String);
+  end;
+
+
+// -------------------------------------------------------
+//   Node
+// -------------------------------------------------------
+
+const
+  ELEMENT_NODE = 1;
+  ATTRIBUTE_NODE = 2;
+  TEXT_NODE = 3;
+  CDATA_SECTION_NODE = 4;
+  ENTITY_REFERENCE_NODE = 5;
+  ENTITY_NODE = 6;
+  PROCESSING_INSTRUCTION_NODE = 7;
+  COMMENT_NODE = 8;
+  DOCUMENT_NODE = 9;
+  DOCUMENT_TYPE_NODE = 10;
+  DOCUMENT_FRAGMENT_NODE = 11;
+  NOTATION_NODE = 12;
+
+type
+
+  TRefClass = class
+  protected
+    RefCounter: LongInt;
+  public
+    constructor Create;
+    function AddRef: LongInt; virtual;
+    function Release: LongInt; virtual;
+  end;
+
+  TDOMNode = class
+  protected
+    FNodeName, FNodeValue: DOMString;
+    FNodeType: Integer;
+    FParentNode: TDOMNode;
+    FPreviousSibling, FNextSibling: TDOMNode;
+    FOwnerDocument: TDOMDocument;
+
+    function  FGetNodeValue: DOMString; virtual;
+    procedure FSetNodeValue(AValue: DOMString); virtual;
+    function  FGetChildNodes: TDOMNodeList; virtual;
+    function  FGetFirstChild: TDOMNode; virtual;
+    function  FGetLastChild: TDOMNode; virtual;
+    function  FGetAttributes: TDOMNamedNodeMap; virtual;
+
+    constructor Create(AOwner: TDOMDocument);
+  public
+    property NodeName: DOMString read FNodeName;
+    property NodeValue: DOMString read FGetNodeValue write FSetNodeValue;
+    property NodeType: Integer read FNodeType;
+    property ParentNode: TDOMNode read FParentNode;
+    property ChildNodes: TDOMNodeList read FGetChildNodes;
+    property FirstChild: TDOMNode read FGetFirstChild;
+    property LastChild: TDOMNode read FGetLastChild;
+    property PreviousSibling: TDOMNode read FPreviousSibling;
+    property NextSibling: TDOMNode read FNextSibling;
+    property Attributes: TDOMNamedNodeMap read FGetAttributes;
+    property OwnerDocument: TDOMDocument read FOwnerDocument;
+
+    function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; virtual;
+    function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; virtual;
+    function RemoveChild(OldChild: TDOMNode): TDOMNode; virtual;
+    function AppendChild(NewChild: TDOMNode): TDOMNode; virtual;
+    function HasChildNodes: Boolean; virtual;
+    function CloneNode(deep: Boolean): TDOMNode;
+
+    // Extensions to DOM interface:
+    function FindNode(const ANodeName: DOMString): TDOMNode;
+  end;
+
+
+  { The following class is an implementation specific extension, it is just an
+    extended implementation of TDOMNode, the generic DOM::Node interface
+    implementation. (Its main purpose is to save memory in a big node tree) }
+
+  TDOMNode_WithChildren = class(TDOMNode)
+  protected
+    FFirstChild, FLastChild: TDOMNode;
+    function FGetChildNodes: TDOMNodeList; virtual;
+    function FGetFirstChild: TDOMNode; override;
+    function FGetLastChild: TDOMNode; override;
+  public
+    function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; override;
+    function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; override;
+    function RemoveChild(OldChild: TDOMNode): TDOMNode; override;
+    function AppendChild(NewChild: TDOMNode): TDOMNode; override;
+    function HasChildNodes: Boolean; override;
+  end;
+
+// -------------------------------------------------------
+//   NodeList
+// -------------------------------------------------------
+
+  // ### should be a descendant of TRefClass   - sg
+
+  TDOMNodeList = class(TList)
+  protected
+    function FGetCount: LongWord;
+    function FGetItem(index: LongWord): TDOMNode;
+  public
+    property Item[index: LongWord]: TDOMNode read FGetItem;
+    property Count: LongWord read FGetCount;
+  end;
+
+
+// -------------------------------------------------------
+//   NamedNodeMap
+// -------------------------------------------------------
+
+  TDOMNamedNodeMap = class(TList)
+  protected
+    OwnerDocument: TDOMDocument;
+    function  FGetItem(index: LongWord): TDOMNode;
+    procedure FSetItem(index: LongWord; AItem: TDOMNode);
+    function  FGetLength: LongWord;
+
+    constructor Create(AOwner: TDOMDocument);
+  public
+    function GetNamedItem(const name: DOMString): TDOMNode;
+    function SetNamedItem(arg: TDOMNode): TDOMNode;
+    function RemoveNamedItem(const name: DOMString): TDOMNode;
+    property Item[index: LongWord]: TDOMNode read FGetItem write FSetItem;
+    property Length: LongWord read FGetLength;
+  end;
+
+
+// -------------------------------------------------------
+//   CharacterData
+// -------------------------------------------------------
+
+  TDOMCharacterData = class(TDOMNode)
+  protected
+    function FGetLength: LongWord;
+  public
+    property Data: DOMString read FNodeValue;
+    property Length: LongWord read FGetLength;
+    function  SubstringData(offset, count: LongWord): DOMString;
+    procedure AppendData(const arg: DOMString);
+    procedure InsertData(offset: LongWord; const arg: DOMString);
+    procedure DeleteData(offset, count: LongWord);
+    procedure ReplaceData(offset, count: LongWord; const arg: DOMString);
+  end;
+
+
+// -------------------------------------------------------
+//   DOMImplementation
+// -------------------------------------------------------
+
+  TDOMImplementation = class
+  public
+    function HasFeature(const feature, version: DOMString): Boolean;
+  end;
+
+
+// -------------------------------------------------------
+//   DocumentFragment
+// -------------------------------------------------------
+
+  TDOMDocumentFragment = class(TDOMNode_WithChildren)
+  protected
+    constructor Create(AOwner: TDOMDocument);
+  end;
+
+
+// -------------------------------------------------------
+//   Document
+// -------------------------------------------------------
+
+  TDOMDocument = class(TDOMNode_WithChildren)
+  protected
+    FDocType: TDOMDocumentType;
+    FImplementation: TDOMImplementation;
+    FDocumentElement: TDOMElement;
+  public
+    property DocType: TDOMDocumentType read FDocType;
+    property Impl: TDOMImplementation read FImplementation;
+    property DocumentElement: TDOMElement read FDocumentElement;
+
+    function CreateElement(const tagName: DOMString): TDOMElement; virtual;
+    function CreateDocumentFragment: TDOMDocumentFragment;
+    function CreateTextNode(const data: DOMString): TDOMText;
+    function CreateComment(const data: DOMString): TDOMComment;
+    function CreateCDATASection(const data: DOMString): TDOMCDATASection;
+      virtual;
+    function CreateProcessingInstruction(const target, data: DOMString):
+      TDOMProcessingInstruction; virtual;
+    function CreateAttribute(const name: DOMString): TDOMAttr; virtual;
+    function CreateEntityReference(const name: DOMString): TDOMEntityReference;
+      virtual;
+    function GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
+
+    // Extensions to DOM interface:
+    constructor Create; virtual;
+    procedure SetDocumentElement(ADocumentElement: TDOMElement);
+  end;
+
+  TXMLDocument = class(TDOMDocument)
+  public
+    function CreateCDATASection(const data: DOMString): TDOMCDATASection;
+      virtual;
+    function CreateProcessingInstruction(const target, data: DOMString):
+      TDOMProcessingInstruction; virtual;
+    function CreateEntityReference(const name: DOMString): TDOMEntityReference;
+      virtual;
+
+    // Extensions to DOM interface:
+    XMLVersion, Encoding: String;
+  end;
+
+
+// -------------------------------------------------------
+//   Attr
+// -------------------------------------------------------
+
+  TDOMAttr = class(TDOMNode_WithChildren)
+  protected
+    FSpecified: Boolean;
+    AttrOwner: TDOMNamedNodeMap;
+    function  FGetNodeValue: DOMString; override;
+    procedure FSetNodeValue(AValue: DOMString); override;
+
+    constructor Create(AOwner: TDOMDocument);
+  public
+    property Name: DOMString read FNodeName;
+    property Specified: Boolean read FSpecified;
+    property Value: DOMString read FNodeValue write FSetNodeValue;
+  end;
+
+
+// -------------------------------------------------------
+//   Element
+// -------------------------------------------------------
+
+  TDOMElement = class(TDOMNode_WithChildren)
+  protected
+    FAttributes: TDOMNamedNodeMap;
+    function FGetAttributes: TDOMNamedNodeMap; override;
+
+    constructor Create(AOwner: TDOMDocument);
+  public
+    property  TagName: DOMString read FNodeName;
+    function  GetAttribute(const name: DOMString): DOMString;
+    procedure SetAttribute(const name, value: DOMString);
+    procedure RemoveAttribute(const name: DOMString);
+    function  GetAttributeNode(const name: DOMString): TDOMAttr;
+    procedure SetAttributeNode(NewAttr: TDOMAttr);
+    function  RemoveAttributeNode(OldAttr: TDOMAttr): TDOMAttr;
+    function  GetElementsByTagName(const name: DOMString): TDOMNodeList;
+    procedure Normalize;
+  end;
+
+
+// -------------------------------------------------------
+//   Text
+// -------------------------------------------------------
+
+  TDOMText = class(TDOMCharacterData)
+  protected
+    constructor Create(AOwner: TDOMDocument);
+  public
+    function SplitText(offset: LongWord): TDOMText;
+  end;
+
+
+// -------------------------------------------------------
+//   Comment
+// -------------------------------------------------------
+
+  TDOMComment = class(TDOMCharacterData)
+  protected
+    constructor Create(AOwner: TDOMDocument);
+  end;
+
+
+// -------------------------------------------------------
+//   CDATASection
+// -------------------------------------------------------
+
+  TDOMCDATASection = class(TDOMText)
+  protected
+    constructor Create(AOwner: TDOMDocument);
+  end;
+
+
+// -------------------------------------------------------
+//   DocumentType
+// -------------------------------------------------------
+
+  TDOMDocumentType = class(TDOMNode)
+  protected
+    FEntities, FNotations: TDOMNamedNodeMap;
+
+    constructor Create(AOwner: TDOMDocument);
+  public
+    property Name: DOMString read FNodeName;
+    property Entities: TDOMNamedNodeMap read FEntities;
+    property Notations: TDOMNamedNodeMap read FEntities;
+  end;
+
+
+// -------------------------------------------------------
+//   Notation
+// -------------------------------------------------------
+
+  TDOMNotation = class(TDOMNode)
+  protected
+    FPublicID, FSystemID: DOMString;
+
+    constructor Create(AOwner: TDOMDocument);
+  public
+    property PublicID: DOMString read FPublicID;
+    property SystemID: DOMString read FSystemID;
+  end;
+
+
+// -------------------------------------------------------
+//   Entity
+// -------------------------------------------------------
+
+  TDOMEntity = class(TDOMNode_WithChildren)
+  protected
+    FPublicID, FSystemID, FNotationName: DOMString;
+
+    constructor Create(AOwner: TDOMDocument);
+  public
+    property PublicID: DOMString read FPublicID;
+    property SystemID: DOMString read FSystemID;
+    property NotationName: DOMString read FNotationName;
+  end;
+
+
+// -------------------------------------------------------
+//   EntityReference
+// -------------------------------------------------------
+
+  TDOMEntityReference = class(TDOMNode_WithChildren)
+  protected
+    constructor Create(AOwner: TDOMDocument);
+  end;
+
+
+// -------------------------------------------------------
+//   ProcessingInstruction
+// -------------------------------------------------------
+
+  TDOMProcessingInstruction = class(TDOMNode)
+  protected
+    constructor Create(AOwner: TDOMDocument);
+  public
+    property Target: DOMString read FNodeName;
+    property Data: DOMString read FNodeValue;
+  end;
+
+
+
+
+// =======================================================
+// =======================================================
+
+implementation
+
+
+constructor TRefClass.Create;
+begin
+  inherited Create;
+  RefCounter := 1;
+end;
+
+function TRefClass.AddRef: LongInt;
+begin
+  Inc(RefCounter);
+  Result := RefCounter;
+end;
+
+function TRefClass.Release: LongInt;
+begin
+  Dec(RefCounter);
+  Result := RefCounter;
+  if RefCounter <= 0 then Free;
+end;
+
+
+// -------------------------------------------------------
+//   DOM Exception
+// -------------------------------------------------------
+
+constructor EDOMError.Create(ACode: Integer; const ASituation: String);
+begin
+  Code := ACode;
+  inherited Create(Self.ClassName + ' in ' + ASituation);
+end;
+
+constructor EDOMIndexSize.Create(const ASituation: String);    // 1
+begin
+  inherited Create(INDEX_SIZE_ERR, ASituation);
+end;
+
+constructor EDOMHierarchyRequest.Create(const ASituation: String);    // 3
+begin
+  inherited Create(HIERARCHY_REQUEST_ERR, ASituation);
+end;
+
+constructor EDOMWrongDocument.Create(const ASituation: String);    // 4
+begin
+  inherited Create(WRONG_DOCUMENT_ERR, ASituation);
+end;
+
+constructor EDOMNotFound.Create(const ASituation: String);    // 8
+begin
+  inherited Create(NOT_FOUND_ERR, ASituation);
+end;
+
+constructor EDOMNotSupported.Create(const ASituation: String);    // 9
+begin
+  inherited Create(NOT_SUPPORTED_ERR, ASituation);
+end;
+
+constructor EDOMInUseAttribute.Create(const ASituation: String);    // 10
+begin
+  inherited Create(INUSE_ATTRIBUTE_ERR, ASituation);
+end;
+
+
+// -------------------------------------------------------
+//   Node
+// -------------------------------------------------------
+
+constructor TDOMNode.Create(AOwner: TDOMDocument);
+begin
+  FOwnerDocument := AOwner;
+  inherited Create;
+end;
+
+function TDOMNode.FGetNodeValue: DOMString;
+begin
+  Result := FNodeValue;
+end;
+
+procedure TDOMNode.FSetNodeValue(AValue: DOMString);
+begin
+  FNodeValue := AValue;
+end;
+
+function TDOMNode.FGetChildNodes: TDOMNodeList;
+begin
+  raise EDOMNotSupported.Create('Node.GetChildNodes');
+end;
+
+function TDOMNode.FGetFirstChild: TDOMNode; begin Result := nil end;
+function TDOMNode.FGetLastChild: TDOMNode; begin Result := nil end;
+function TDOMNode.FGetAttributes: TDOMNamedNodeMap; begin Result := nil end;
+
+function TDOMNode.InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode;
+begin
+  raise EDOMHierarchyRequest.Create('Node.InsertBefore');
+end;
+
+function TDOMNode.ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode;
+begin
+  raise EDOMHierarchyRequest.Create('Node.ReplaceChild');
+end;
+
+function TDOMNode.RemoveChild(OldChild: TDOMNode): TDOMNode;
+begin
+  raise EDOMHierarchyRequest.Create('Node.RemoveChild');
+end;
+
+function TDOMNode.AppendChild(NewChild: TDOMNode): TDOMNode;
+begin
+  raise EDOMHierarchyRequest.Create('Node.AppendChild');
+end;
+
+function TDOMNode.HasChildNodes: Boolean;
+begin
+  Result := False;
+end;
+
+function TDOMNode.CloneNode(deep: Boolean): TDOMNode;
+begin
+  Result := nil;
+end;
+
+function TDOMNode.FindNode(const ANodeName: DOMString): TDOMNode;
+var
+  child: TDOMNode;
+begin
+  child := FirstChild;
+  while child <> nil do begin
+    if child.NodeName = ANodeName then begin
+      Result := child;
+      exit;
+    end;
+    child := child.NextSibling;
+  end;
+  Result := nil;
+end;
+
+
+function TDOMNode_WithChildren.FGetFirstChild: TDOMNode;
+begin
+  Result := FFirstChild;
+end;
+
+function TDOMNode_WithChildren.FGetLastChild: TDOMNode;
+begin
+  Result := FLastChild;
+end;
+
+function TDOMNode_WithChildren.FGetChildNodes: TDOMNodeList;
+begin
+  raise EDOMNotSupported.Create('NodeWC.GetChildNodes');
+end;
+
+function TDOMNode_WithChildren.InsertBefore(NewChild, RefChild: TDOMNode):
+  TDOMNode;
+var
+  i: Integer;
+begin
+  if RefChild = nil then begin
+    AppendChild(NewChild);
+    exit(NewChild);
+  end;
+
+  if NewChild.FOwnerDocument <> FOwnerDocument then
+    raise EDOMWrongDocument.Create('NodeWC.InsertBefore');
+
+  if RefChild.ParentNode <> Self then
+    raise EDOMHierarchyRequest.Create('NodeWC.InsertBefore');
+
+  if NewChild.NodeType = DOCUMENT_FRAGMENT_NODE then
+    raise EDOMNotSupported.Create('NodeWC.InsertBefore for DocumentFragment');
+
+  NewChild.FNextSibling := RefChild;
+  if RefChild = FFirstChild then
+    FFirstChild := NewChild
+  else
+    RefChild.FPreviousSibling.FNextSibling := NewChild;
+
+  RefChild.FPreviousSibling := NewChild;
+
+  Result := NewChild;
+end;
+
+function TDOMNode_WithChildren.ReplaceChild(NewChild, OldChild: TDOMNode):
+  TDOMNode;
+begin
+  InsertBefore(NewChild, OldChild);
+  RemoveChild(OldChild);
+  Result := NewChild;
+end;
+
+function TDOMNode_WithChildren.RemoveChild(OldChild: TDOMNode):
+  TDOMNode;
+begin
+  if OldChild.ParentNode <> Self then
+    raise EDOMHierarchyRequest.Create('NodeWC.RemoveChild');
+
+  if OldChild = FFirstChild then
+    FFirstChild := nil
+  else
+    OldChild.FPreviousSibling.FNextSibling := OldChild.FNextSibling;
+
+  if OldChild = FLastChild then
+    FLastChild := nil
+  else
+    OldChild.FNextSibling.FPreviousSibling := OldChild.FPreviousSibling;
+end;
+
+function TDOMNode_WithChildren.AppendChild(NewChild: TDOMNode): TDOMNode;
+var
+  parent: TDOMNode;
+begin
+  if NewChild.FOwnerDocument <> FOwnerDocument then
+    raise EDOMWrongDocument.Create('NodeWC.AppendChild');
+
+  parent := Self;
+  while parent <> nil do begin
+    if parent = NewChild then
+      raise EDOMHierarchyRequest.Create('NodeWC.AppendChild (cycle in tree)');
+    parent := parent.ParentNode;
+  end;
+
+  if NewChild.FParentNode = Self then
+    RemoveChild(NewChild);
+
+  if NewChild.NodeType = DOCUMENT_FRAGMENT_NODE then begin
+    raise EDOMNotSupported.Create('NodeWC.AppendChild for DocumentFragments');
+  end else begin
+    if FLastChild = nil then
+      FFirstChild := NewChild
+    else begin
+      FLastChild.FNextSibling := NewChild;
+      NewChild.FPreviousSibling := FLastChild;
+    end;
+    FLastChild := NewChild;
+    NewChild.FParentNode := Self;
+  end;
+  Result := NewChild;
+end;
+
+
+function TDOMNode_WithChildren.HasChildNodes: Boolean;
+begin
+  Result := FFirstChild <> nil;
+end;
+
+
+// -------------------------------------------------------
+//   NodeList
+// -------------------------------------------------------
+
+
+function TDOMNodeList.FGetCount: LongWord;
+begin
+//  Result := LongWord(inherited Count);
+end;
+
+function TDOMNodeList.FGetItem(index: LongWord): TDOMNode;
+begin
+  if (index < 0) or (index >= Count) then
+    Result := nil
+  else
+    Result := TDOMNode(Items[index]);
+end;
+
+
+// -------------------------------------------------------
+//   NamedNodeMap
+// -------------------------------------------------------
+
+constructor TDOMNamedNodeMap.Create(AOwner: TDOMDocument);
+begin
+  inherited Create;
+  OwnerDocument := AOwner;
+end;
+
+function TDOMNamedNodeMap.FGetItem(index: LongWord): TDOMNode;
+begin
+  Result := TDOMNode(Items[index]);
+end;
+
+procedure TDOMNamedNodeMap.FSetItem(index: LongWord; AItem: TDOMNode);
+begin
+  Items[index] := AItem;
+end;
+
+function TDOMNamedNodeMap.FGetLength: LongWord;
+begin
+  Result := LongWord(Count);
+end;
+
+function TDOMNamedNodeMap.GetNamedItem(const name: DOMString): TDOMNode;
+var
+  i: Integer;
+begin
+  for i := 0 to Count - 1 do
+    if Item[i].NodeName = name then
+      exit(Item[i]);
+  Result := nil;
+end;
+
+function TDOMNamedNodeMap.SetNamedItem(arg: TDOMNode): TDOMNode;
+var
+  i: Integer;
+begin
+  if arg.FOwnerDocument <> OwnerDocument then
+    raise EDOMWrongDocument.Create('NamedNodeMap.SetNamedItem');
+
+  if arg.NodeType = ATTRIBUTE_NODE then begin
+    if TDOMAttr(arg).AttrOwner <> nil then
+      raise EDOMInUseAttribute.Create('NamedNodeMap.SetNamedItem');
+    TDOMAttr(arg).AttrOwner := Self;
+  end;
+
+  for i := 0 to Count - 1 do
+    if Item[i].NodeName = arg.NodeName then begin
+      Result := Item[i];
+      Item[i] := arg;
+      exit;
+    end;
+  Add(arg);
+  Result := nil;
+end;
+
+function TDOMNamedNodeMap.RemoveNamedItem(const name: DOMString): TDOMNode;
+var
+  i: Integer;
+begin
+  for i := 0 to Count - 1 do
+    if Item[i].NodeName = name then begin
+      Result := Item[i];
+      Result.FParentNode := nil;
+      exit;
+    end;
+  raise EDOMNotFound.Create('NamedNodeMap.RemoveNamedItem');
+end;
+
+
+// -------------------------------------------------------
+//   CharacterData
+// -------------------------------------------------------
+
+function TDOMCharacterData.FGetLength: LongWord;
+begin
+  Result := system.Length(FNodeValue);
+end;
+
+function TDOMCharacterData.SubstringData(offset, count: LongWord): DOMString;
+begin
+  if (offset < 0) or (offset > Length) or (count < 0) then
+    raise EDOMIndexSize.Create('CharacterData.SubstringData');
+  Result := Copy(FNodeValue, offset + 1, count);
+end;
+
+procedure TDOMCharacterData.AppendData(const arg: DOMString);
+begin
+  FNodeValue := FNodeValue + arg;
+end;
+
+procedure TDOMCharacterData.InsertData(offset: LongWord; const arg: DOMString);
+begin
+  if (offset < 0) or (offset > Length) then
+    raise EDOMIndexSize.Create('CharacterData.InsertData');
+
+  FNodeValue := Copy(FNodeValue, 1, offset) + arg +
+    Copy(FNodeValue, offset + 1, Length);
+end;
+
+procedure TDOMCharacterData.DeleteData(offset, count: LongWord);
+begin
+  if (offset < 0) or (offset > Length) or (count < 0) then
+    raise EDOMIndexSize.Create('CharacterData.DeleteData');
+
+  FNodeValue := Copy(FNodeValue, 1, offset) +
+    Copy(FNodeValue, offset + count + 1, Length);
+end;
+
+procedure TDOMCharacterData.ReplaceData(offset, count: LongWord; const arg: DOMString);
+begin
+  DeleteData(offset, count);
+  InsertData(offset, arg);
+end;
+
+
+// -------------------------------------------------------
+//   DocumentFragmet
+// -------------------------------------------------------
+
+constructor TDOMDocumentFragment.Create(AOwner: TDOMDocument);
+begin
+  FNodeType := DOCUMENT_FRAGMENT_NODE;
+  FNodeName := '#document-fragment';
+  inherited Create(AOwner);
+end;
+
+
+// -------------------------------------------------------
+//   DOMImplementation
+// -------------------------------------------------------
+
+function TDOMImplementation.HasFeature(const feature, version: DOMString):
+  Boolean;
+begin
+  Result := False;
+end;
+
+
+// -------------------------------------------------------
+//   Document
+// -------------------------------------------------------
+
+constructor TDOMDocument.Create;
+begin
+  FNodeType := DOCUMENT_NODE;
+  FNodeName := '#document';
+  inherited Create(nil);
+  FOwnerDocument := Self;
+end;
+
+procedure TDOMDocument.SetDocumentElement(ADocumentElement: TDOMElement);
+begin
+  FDocumentElement := ADocumentElement;
+end;
+
+function TDOMDocument.CreateElement(const tagName: DOMString): TDOMElement;
+begin
+  Result := TDOMElement.Create(Self);
+  Result.FNodeName := tagName;
+end;
+
+function TDOMDocument.CreateDocumentFragment: TDOMDocumentFragment;
+begin
+  Result := TDOMDocumentFragment.Create(Self);
+end;
+
+function TDOMDocument.CreateTextNode(const data: DOMString): TDOMText;
+begin
+  Result := TDOMText.Create(Self);
+  Result.FNodeValue := data;
+end;
+
+function TDOMDocument.CreateComment(const data: DOMString): TDOMComment;
+begin
+  Result := TDOMComment.Create(Self);
+  Result.FNodeValue := data;
+end;
+
+function TDOMDocument.CreateCDATASection(const data: DOMString):
+  TDOMCDATASection;
+begin
+  raise EDOMNotSupported.Create('DOMDocument.CreateCDATASection');
+end;
+
+function TDOMDocument.CreateProcessingInstruction(const target,
+  data: DOMString): TDOMProcessingInstruction;
+begin
+  raise EDOMNotSupported.Create('DOMDocument.CreateProcessingInstruction');
+end;
+
+function TDOMDocument.CreateAttribute(const name: DOMString): TDOMAttr;
+begin
+  Result := TDOMAttr.Create(Self);
+  Result.FNodeName := name;
+end;
+
+function TDOMDocument.CreateEntityReference(const name: DOMString):
+  TDOMEntityReference;
+begin
+  raise EDOMNotSupported.Create('DOMDocument.CreateEntityReference');
+end;
+
+function TDOMDocument.GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
+var
+  i: Integer;
+begin
+  Result := TDOMNodeList.Create;
+  if ChildNodes <> nil then
+    for i := 0 to ChildNodes.Count - 1 do
+      if (tagname = '*') or (tagname = ChildNodes.Item[i].FNodeName) then
+        Result.Add(ChildNodes.Item[i]);
+end;
+
+
+function TXMLDocument.CreateCDATASection(const data: DOMString):
+  TDOMCDATASection;
+begin
+  Result := TDOMCDATASection.Create(Self);
+  Result.FNodeValue := data;
+end;
+
+function TXMLDocument.CreateProcessingInstruction(const target,
+  data: DOMString): TDOMProcessingInstruction;
+begin
+  Result := TDOMProcessingInstruction.Create(Self);
+  Result.FNodeName := target;
+  Result.FNodeValue := data;
+end;
+
+function TXMLDocument.CreateEntityReference(const name: DOMString):
+  TDOMEntityReference;
+begin
+  Result := TDOMEntityReference.Create(Self);
+  Result.FNodeName := name;
+end;
+
+
+// -------------------------------------------------------
+//   Attr
+// -------------------------------------------------------
+
+constructor TDOMAttr.Create(AOwner: TDOMDocument);
+begin
+  FNodeType := ATTRIBUTE_NODE;
+  inherited Create(AOwner);
+end;
+
+function TDOMAttr.FGetNodeValue: DOMString;
+begin
+  if FFirstChild = nil then
+    Result := ''
+  else
+    Result := FFirstChild.NodeValue;
+end;
+
+procedure TDOMAttr.FSetNodeValue(AValue: DOMString);
+var
+  tn: TDOMText;
+begin
+  FSpecified := True;
+  tn := TDOMText.Create(FOwnerDocument);
+  tn.FNodeValue := AValue;
+  if FFirstChild <> nil then
+    ReplaceChild(tn, FFirstChild)
+  else
+    AppendChild(tn);
+end;
+
+
+// -------------------------------------------------------
+//   Element
+// -------------------------------------------------------
+
+constructor TDOMElement.Create(AOwner: TDOMDocument);
+begin
+  FNodeType := ELEMENT_NODE;
+  inherited Create(AOwner);
+  FAttributes := TDOMNamedNodeMap.Create(AOwner);
+end;
+
+function TDOMElement.FGetAttributes: TDOMNamedNodeMap;
+begin
+  Result := FAttributes;
+end;
+
+function TDOMElement.GetAttribute(const name: DOMString): DOMString;
+var
+  i: Integer;
+begin
+  for i := 0 to FAttributes.Count - 1 do
+    if FAttributes.Item[i].NodeName = name then
+      exit(FAttributes.Item[i].NodeValue);
+  Result := '';
+end;
+
+procedure TDOMElement.SetAttribute(const name, value: DOMString);
+var
+  i: Integer;
+  attr: TDOMAttr;
+begin
+  for i := 0 to FAttributes.Count - 1 do
+    if FAttributes.Item[i].NodeName = name then begin
+      FAttributes.Item[i].NodeValue := value;
+      exit;
+    end;
+  attr := TDOMAttr.Create(FOwnerDocument);
+  attr.FNodeName := name;
+  attr.NodeValue := value;
+  FAttributes.Add(attr);
+end;
+
+procedure TDOMElement.RemoveAttribute(const name: DOMString);
+var
+  i: Integer;
+begin
+  for i := 0 to FAttributes.Count - 1 do
+    if FAttributes.Item[i].NodeName = name then begin
+      FAttributes.Delete(i);
+      FAttributes.Item[i].Free;
+      exit;
+    end;
+end;
+
+function TDOMElement.GetAttributeNode(const name: DOMString): TDOMAttr;
+var
+  i: Integer;
+begin
+  for i := 0 to FAttributes.Count - 1 do
+    if FAttributes.Item[i].NodeName = name then
+      exit(TDOMAttr(FAttributes.Item[i]));
+  Result := nil;
+end;
+
+procedure TDOMElement.SetAttributeNode(NewAttr: TDOMAttr);
+var
+  i: Integer;
+begin
+  for i := 0 to FAttributes.Count - 1 do
+    if FAttributes.Item[i].NodeName = NewAttr.NodeName then begin
+      FAttributes.Item[i].Free;
+      FAttributes.Item[i] := NewAttr;
+      exit;
+    end;
+end;
+
+function TDOMElement.RemoveAttributeNode(OldAttr: TDOMAttr): TDOMAttr;
+var
+  i: Integer;
+  node: TDOMNode;
+begin
+  for i := 0 to FAttributes.Count - 1 do begin
+    node := FAttributes.Item[i];
+    if node = OldAttr then begin
+      FAttributes.Delete(i);
+      exit(TDOMAttr(node));
+    end;
+  end;
+end;
+
+function TDOMElement.GetElementsByTagName(const name: DOMString): TDOMNodeList;
+var
+  i: Integer;
+begin
+  Result := TDOMNodeList.Create;
+  for i := 0 to FAttributes.Count - 1 do
+    if (name = '*') or (name = FAttributes.Item[i].NodeName) then
+      Result.Add(FAttributes.Item[i]);
+end;
+
+procedure TDOMElement.Normalize;
+begin
+end;
+
+
+// -------------------------------------------------------
+//   Text
+// -------------------------------------------------------
+
+constructor TDOMText.Create(AOwner: TDOMDocument);
+begin
+  FNodeType := TEXT_NODE;
+  FNodeName := '#text';
+  inherited Create(AOwner);
+end;
+
+function TDOMText.SplitText(offset: LongWord): TDOMText;
+var
+  nt: TDOMText;
+begin
+  if offset > Length then
+    raise EDOMIndexSize.Create('Text.SplitText');
+
+  nt := TDOMText.Create(FOwnerDocument);
+  nt.FNodeValue := Copy(FNodeValue, offset + 1, Length);
+  FNodeValue := Copy(FNodeValue, 1, offset);
+  FParentNode.InsertBefore(nt, FNextSibling);
+end;
+
+
+// -------------------------------------------------------
+//   Comment
+// -------------------------------------------------------
+
+constructor TDOMComment.Create(AOwner: TDOMDocument);
+begin
+  FNodeType := COMMENT_NODE;
+  FNodeName := '#comment';
+  inherited Create(AOwner);
+end;
+
+
+// -------------------------------------------------------
+//   CDATASection
+// -------------------------------------------------------
+
+constructor TDOMCDATASection.Create(AOwner: TDOMDocument);
+begin
+  FNodeType := CDATA_SECTION_NODE;
+  FNodeName := '#cdata-section';
+  inherited Create(AOwner);
+end;
+
+
+// -------------------------------------------------------
+//   DocumentType
+// -------------------------------------------------------
+
+constructor TDOMDocumentType.Create(AOwner: TDOMDocument);
+begin
+  FNodeType := DOCUMENT_TYPE_NODE;
+  inherited Create(AOwner);
+end;
+
+
+// -------------------------------------------------------
+//   Notation
+// -------------------------------------------------------
+
+constructor TDOMNotation.Create(AOwner: TDOMDocument);
+begin
+  FNodeType := NOTATION_NODE;
+  inherited Create(AOwner);
+end;
+
+
+// -------------------------------------------------------
+//   Entity
+// -------------------------------------------------------
+
+constructor TDOMEntity.Create(AOwner: TDOMDocument);
+begin
+  FNodeType := ENTITY_NODE;
+  inherited Create(AOwner);
+end;
+
+
+// -------------------------------------------------------
+//   EntityReference
+// -------------------------------------------------------
+
+constructor TDOMEntityReference.Create(AOwner: TDOMDocument);
+begin
+  FNodeType := ENTITY_REFERENCE_NODE;
+  inherited Create(AOwner);
+end;
+
+
+// -------------------------------------------------------
+//   ProcessingInstruction
+// -------------------------------------------------------
+
+constructor TDOMProcessingInstruction.Create(AOwner: TDOMDocument);
+begin
+  FNodeType := PROCESSING_INSTRUCTION_NODE;
+  inherited Create(AOwner);
+end;
+
+
+end.
+
+
+{
+  $Log$
+  Revision 1.1  1999-07-09 08:35:09  michael
+  + Initial implementation by Sebastian Guenther
+
+}

fcl/xml/xmlcfg.pp

@@ -0,0 +1,181 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c)  1999 Sebastian Guenther, [email protected]
+
+    Implementation of TXMLConfig class
+    
+    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.
+
+ **********************************************************************}
+
+{
+  TXMLConfig enables applications to use XML files for storing their
+  configuration data
+}
+
+{$MODE objfpc}
+
+unit xmlcfg;
+
+interface
+uses DOM, xmlread, xmlwrite;
+
+type
+
+  TXMLConfig = class
+  protected
+    doc: TXMLDocument;
+    FileName: String;
+  public
+    constructor Create(AFileName: String);
+    destructor Destroy; override;
+    procedure Flush;
+    function  GetValue(APath, ADefault: String): String;
+    function  GetValue(APath: String; ADefault: Integer): Integer;
+    function  GetValue(APath: String; ADefault: Boolean): Boolean;
+    procedure SetValue(APath, AValue: String);
+    procedure SetValue(APath: String; AValue: Integer);
+    procedure SetValue(APath: String; AValue: Boolean);
+  end;
+
+
+implementation
+
+uses sysutils;
+
+
+constructor TXMLConfig.Create(AFileName: String);
+var
+  f: File;
+  cfg: TDOMElement;
+begin
+  FileName := AFileName;
+  Assign(f, AFileName);
+  {$I-}
+  Reset(f, 1);
+  {$I+}
+  if IOResult = 0 then begin
+    doc := ReadXMLFile(f);
+    Close(f);
+    doc.SetDocumentElement(TDOMElement(doc.FindNode('CONFIG')));
+  end else begin
+    doc := TXMLDocument.Create;
+    cfg := doc.CreateElement('CONFIG');
+    doc.AppendChild(cfg);
+    doc.SetDocumentElement(cfg);
+  end;
+end;
+
+destructor TXMLConfig.Destroy;
+begin
+  Flush;
+  inherited Destroy;
+end;
+
+procedure TXMLConfig.Flush;
+var
+  f: Text;
+begin
+  Assign(f, FileName);
+  Rewrite(f);
+  WriteXMLFile(doc, f);
+  Close(f);
+end;
+
+function TXMLConfig.GetValue(APath, ADefault: String): String;
+var
+  node, subnode, attr: TDOMNode;
+  i: Integer;
+  name: String;
+begin
+  node := doc.DocumentElement;
+  while True do begin
+    i := Pos('/', APath);
+    if i = 0 then break;
+    name := Copy(APath, 1, i - 1);
+    APath := Copy(APath, i + 1, Length(APath));
+    subnode := node.FindNode(name);
+    if subnode = nil then begin
+      Result := ADefault;
+      exit;
+    end;
+    node := subnode;
+  end;
+  attr := node.Attributes.GetNamedItem(APath);
+  if attr = nil then
+    Result := ADefault
+  else
+    Result := attr.NodeValue;
+end;
+
+function TXMLConfig.GetValue(APath: String; ADefault: Integer): Integer;
+begin
+  Result := StrToInt(GetValue(APath, IntToStr(ADefault)));
+end;
+
+function TXMLConfig.GetValue(APath: String; ADefault: Boolean): Boolean;
+var
+  s: String;
+begin
+  if ADefault then s := 'True'
+  else s := 'False';
+  s := GetValue(APath, s);
+  if UpperCase(s) = 'TRUE' then Result := True
+  else if UpperCase(s) = 'FALSE' then Result := False
+  else Result := ADefault;
+end;
+
+procedure TXMLConfig.SetValue(APath, AValue: String);
+var
+  node, subnode, attr: TDOMNode;
+  i: Integer;
+  name: String;
+begin
+  node := doc.DocumentElement;
+  while True do begin
+    i := Pos('/', APath);
+    if i = 0 then break;
+    name := Copy(APath, 1, i - 1);
+    APath := Copy(APath, i + 1, Length(APath));
+    subnode := node.FindNode(name);
+    if subnode = nil then begin
+      subnode := doc.CreateElement(name);
+      node.AppendChild(subnode);
+    end;
+    node := subnode;
+  end;
+  attr := node.Attributes.GetNamedItem(APath);
+  if attr = nil then begin
+    attr := doc.CreateAttribute(APath);
+    node.Attributes.SetNamedItem(attr);
+  end;
+  attr.NodeValue := AValue;
+end;
+
+procedure TXMLConfig.SetValue(APath: String; AValue: Integer);
+begin
+  SetValue(APath, IntToStr(AValue));
+end;
+
+procedure TXMLConfig.SetValue(APath: String; AValue: Boolean);
+begin
+  if AValue then SetValue(APath, 'True')
+  else SetValue(APath, 'False');
+end;
+
+
+end.
+
+
+{
+  $Log$
+  Revision 1.1  1999-07-09 08:35:09  michael
+  + Initial implementation by Sebastian Guenther
+
+}

fcl/xml/xmlread.pp

@@ -0,0 +1,901 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999 Sebastian Guenther
+
+    XML reading routines.
+    
+    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.
+
+ **********************************************************************}
+
+{$MODE objfpc}
+{$H+}
+
+unit xmlread;
+
+interface
+
+uses DOM, debug;
+
+function ReadXMLFile(var f: File): TXMLDocument;
+function ReadDTDFile(var f: File): TXMLDocument;
+
+
+implementation
+
+uses sysutils;
+
+const
+
+  Letter = ['A'..'Z', 'a'..'z'];
+  Digit = ['0'..'9'];
+  PubidChars: set of Char = [' ', #13, #10, 'a'..'z', 'A'..'Z', '0'..'9',
+    '-', '''', '(', ')', '+', ',', '.', '/', ':', '=', '?', ';', '!', '*',
+    '#', '@', '$', '_', '%'];
+
+  NmToken: set of Char = Letter + Digit + ['.', '-', '_', ':'];
+
+type
+
+  TSetOfChar = set of Char;
+
+  TXMLReader = class
+  protected
+    doc: TXMLDocument;
+    buf: PChar;
+
+    procedure RaiseExc(descr: String);
+    function  SkipWhitespace: Boolean;
+    procedure ExpectWhitespace;
+    procedure ExpectString(s: String);
+    function  CheckFor(s: PChar): Boolean;
+    function  GetString(ValidChars: TSetOfChar): String;
+
+    function  GetName(var s: String): Boolean;
+    function  ExpectName: String;					// [5]
+    procedure ExpectAttValue(attr: TDOMAttr);				// [10]
+    function  ExpectPubidLiteral: String;				// [12]
+    function  ParseComment: Boolean;					// [15]
+    function  ParsePI: Boolean;						// [16]
+    procedure ExpectProlog;			    			// [22]
+    function  ParseEq: Boolean;						// [25]
+    procedure ExpectEq;
+    procedure ParseMisc;						// [27]
+    function  ParseMarkupDecl: Boolean;					// [29]
+    function  ParseElement(owner: TDOMNode): Boolean;			// [39]
+    procedure ExpectElement(owner: TDOMNode);
+    function  ParseReference: Boolean;					// [67]
+    procedure ExpectReference;
+    function  ParsePEReference: Boolean;				// [69]
+    function  ParseExternalID: Boolean;					// [75]
+    procedure ExpectExternalID;
+    function  ParseEncodingDecl: String;    				// [80]
+  public
+    function ProcessXML(ABuf: PChar): TXMLDocument;    			// [1]
+    function ProcessDTD(ABuf: PChar): TXMLDocument;			// ([29])
+  end;
+
+
+
+procedure TXMLReader.RaiseExc(descr: String);
+begin
+  WriteLn('Throwing exception: ', descr);
+  raise Exception.Create('In XML reader: ' + descr);
+end;
+
+function TXMLReader.SkipWhitespace: Boolean;
+begin
+  dbg_push('SkipWhitespace');
+  Result := False;
+  while buf[0] in [#9, #10, #13, ' '] do begin
+    Inc(buf);
+    Result := True;
+  end;
+  dbg_pop;
+end;
+
+procedure TXMLReader.ExpectWhitespace;
+begin
+  if not SkipWhitespace then
+    RaiseExc('Expected whitespace');
+end;
+
+procedure TXMLReader.ExpectString(s: String);
+var
+  i: Integer;
+  s2: PChar;
+  s3: String;
+begin
+  dbg_push('ExpectString');
+  for i := 1 to Length(s) do
+    if buf[i - 1] <> s[i] then begin
+      GetMem(s2, Length(s) + 1);
+      StrLCopy(s2, buf, Length(s));
+      s3 := StrPas(s2);
+      FreeMem(s2, Length(s) + 1);
+      RaiseExc('Expected "' + s + '", found "' + s3 + '"');
+    end;
+  Inc(buf, Length(s));
+  dbg_pop;
+end;
+
+function TXMLReader.CheckFor(s: PChar): Boolean;
+begin
+  dbg_push('CheckFor');
+  if buf[0] = #0 then exit(False);
+  if StrLComp(buf, s, StrLen(s)) = 0 then begin
+    Inc(buf, StrLen(s));
+    Result := True;
+  end else
+    Result := False;
+  dbg_pop;
+end;
+
+function TXMLReader.GetString(ValidChars: TSetOfChar): String;
+begin
+  dbg_push('GetString');
+  Result := '';
+  while buf[0] in ValidChars do begin
+    Result := Result + buf[0];
+    Inc(buf);
+  end;
+  dbg_pop;
+end;
+
+function TXMLReader.ProcessXML(ABuf: PChar): TXMLDocument;    // [1]
+var
+  LastNodeBeforeDoc: TDOMNode;
+begin
+  dbg_push('ProcessXML');
+  buf := ABuf;
+
+  doc := TXMLDocument.Create;
+  ExpectProlog;
+  LastNodeBeforeDoc := doc.LastChild;
+  ExpectElement(doc);
+  ParseMisc;
+
+  if buf[0] <> #0 then begin
+    WriteLn('=== Unparsed: ===');
+    //WriteLn(buf);
+    WriteLn(StrLen(buf), ' chars');
+  end;
+
+  Result := doc;
+  dbg_pop;
+end;
+
+
+function TXMLReader.GetName(var s: String): Boolean;    // [5]
+begin
+  dbg_push('GetName. buf[0]=' + buf[0]);
+  s := '';
+  if not (buf[0] in (Letter + ['_', ':'])) then
+    exit(False);
+
+  s := buf[0];
+  Inc(buf);
+  s := s + GetString(Letter + ['0'..'9', '.', '-', '_', ':']);
+  Result := True;
+  dbg_pop;
+end;
+
+function TXMLReader.ExpectName: String;    // [5]
+begin
+  dbg_push('ExpectName. buf[0]=' + buf[0]);
+  if not (buf[0] in (Letter + ['_', ':'])) then
+    RaiseExc('Expected letter, "_" or ":" for name, found "' + buf[0] + '"');
+
+  Result := buf[0];
+  Inc(buf);
+  Result := Result + GetString(Letter + ['0'..'9', '.', '-', '_', ':']);
+  dbg_pop;
+end;
+
+procedure TXMLReader.ExpectAttValue(attr: TDOMAttr);    // [10]
+var
+  strdel: array[0..1] of Char;
+  s: String;
+begin
+  dbg_push('ExpectAttValue');
+  if (buf[0] <> '''') and (buf[0] <> '"') then
+    RaiseExc('Expected quotation marks');
+  strdel[0] := buf[0];
+  strdel[1] := #0;
+  Inc(buf);
+  s := '';
+  while not CheckFor(strdel) do
+    if not ParseReference then begin
+      s := s + buf[0];
+      Inc(buf);
+    end else begin
+      if s <> '' then begin
+        attr.AppendChild(doc.CreateTextNode(s));
+        s := '';
+      end;
+    end;
+
+  if s <> '' then
+    attr.AppendChild(doc.CreateTextNode(s));
+
+  dbg_pop;
+end;
+
+function TXMLReader.ExpectPubidLiteral: String;
+begin
+  dbg_push('ExpectPubidLiteral');
+  Result := '';
+  if CheckFor('''') then begin
+    GetString(PubidChars - ['''']);
+    ExpectString('''');
+  end else if CheckFor('"') then begin
+    GetString(PubidChars - ['"']);
+    ExpectString('"');
+  end else
+    RaiseExc('Expected quotation marks');
+  dbg_pop;
+end;
+
+function TXMLReader.ParseComment: Boolean;    // [15]
+begin
+  dbg_push('ParseComment');
+  if CheckFor('<!--') then begin
+    while (buf[0] <> #0) and (buf[1] <> #0) and
+      ((buf[0] <> '-') or (buf[1] <> '-')) do Inc(buf);
+    ExpectString('-->');
+    Result := True;
+  end else
+    Result := False;
+  dbg_pop;
+end;
+
+function TXMLReader.ParsePI: Boolean;    // [16]
+var
+  checkbuf: array[0..3] of char;
+begin
+  dbg_push('ParsePI');
+  if CheckFor('<?') then begin
+    StrLCopy(checkbuf, buf, 3);
+    if UpCase(StrPas(checkbuf)) = 'XML' then
+      RaiseExc('"<?XML" processing instruction not allowed here');
+    ExpectName;
+    if SkipWhitespace then
+      while (buf[0] <> #0) and (buf[1] <> #0) and
+        (buf[0] <> '?') and (buf[1] <> '>') do Inc(buf);
+    ExpectString('?>');
+  end else
+    Result := False;
+  dbg_pop;
+end;
+
+procedure TXMLReader.ExpectProlog;    // [22]
+
+  procedure ParseVersionNum;
+  begin
+    doc.XMLVersion :=
+      GetString(['a'..'z', 'A'..'Z', '0'..'9', '_', '.', ':', '-']);
+  end;
+
+begin
+  dbg_push('ExpectProlog');
+  if CheckFor('<?xml') then begin
+    // '<?xml' VersionInfo EncodingDecl? SDDecl? S? '?>'
+
+    // VersionInfo: S 'version' Eq (' VersionNum ' | " VersionNum ")
+    SkipWhitespace;
+    ExpectString('version');
+    ParseEq;
+    if buf[0] = '''' then begin
+      Inc(buf);
+      ParseVersionNum;
+      ExpectString('''');
+    end else if buf[0] = '"' then begin
+      Inc(buf);
+      ParseVersionNum;
+      ExpectString('"');
+    end else
+      RaiseExc('Expected single or double quotation mark');
+
+    // EncodingDecl?
+    ParseEncodingDecl;
+
+    // SDDecl?
+    SkipWhitespace;
+    if CheckFor('standalone') then begin
+      ExpectEq;
+      if buf[0] = '''' then begin
+        Inc(buf);
+	if not (CheckFor('yes''') or CheckFor('no''')) then
+	  RaiseExc('Expected ''yes'' or ''no''');
+      end else if buf[0] = '''' then begin
+        Inc(buf);
+	if not (CheckFor('yes"') or CheckFor('no"')) then
+	  RaiseExc('Expected "yes" or "no"');
+      end;
+      SkipWhitespace;
+    end;
+
+    ExpectString('?>');
+  end;
+
+  // Check for "Misc*"
+  ParseMisc;
+
+  // Check for "(doctypedecl Misc*)?"
+  if CheckFor('<!DOCTYPE') then begin
+    SkipWhitespace;
+    ExpectName;
+    SkipWhitespace;
+    ParseExternalID;
+    SkipWhitespace;
+    if CheckFor('[') then begin
+      repeat
+        SkipWhitespace;
+      until not (ParseMarkupDecl or ParsePEReference);
+      ExpectString(']');
+      SkipWhitespace;
+    end;
+    ParseMisc;
+  end;
+
+  dbg_pop;
+end;
+
+function TXMLReader.ParseEq: Boolean;    // [25]
+var
+  savedbuf: PChar;
+begin
+  dbg_push('ParseEq');
+  savedbuf := buf;
+  SkipWhitespace;
+  if buf[0] = '=' then begin
+    Inc(buf);
+    SkipWhitespace;
+    Result := True;
+  end else begin
+    buf := savedbuf;
+    Result := False;
+  end;
+  dbg_pop;
+end;
+
+procedure TXMLReader.ExpectEq;
+begin
+  if not ParseEq then
+    RaiseExc('Expected "="');
+end;
+
+
+// Parse "Misc*": 
+//   Misc ::= Comment | PI | S
+
+procedure TXMLReader.ParseMisc;    // [27]
+begin
+  dbg_push('ParseMisc');
+  repeat
+    SkipWhitespace;
+  until not (ParseComment or ParsePI);
+  dbg_pop;
+end;
+
+function TXMLReader.ParseMarkupDecl: Boolean;    // [29]
+
+  function ParseElementDecl: Boolean;    // [45]
+
+    procedure ExpectChoiceOrSeq;    // [49], [50]
+
+      procedure ExpectCP;    // [48]
+      begin
+        dbg_push('ExpectCP');
+        if CheckFor('(') then
+	  ExpectChoiceOrSeq
+	else
+	  ExpectName;
+	if CheckFor('?') then
+	else if CheckFor('*') then
+	else if CheckFor('+') then;
+	dbg_pop;
+      end;
+
+    var
+      delimiter: Char;
+    begin
+      dbg_push('ExpectChoiceOrSeq');
+      SkipWhitespace;
+      ExpectCP;
+      SkipWhitespace;
+      delimiter := #0;
+      while not CheckFor(')') do begin
+        if delimiter = #0 then begin
+	  if (buf[0] = '|') or (buf[0] = ',') then
+	    delimiter := buf[0]
+	  else
+	    RaiseExc('Expected "|" or ","');
+	  Inc(buf);
+	end else
+	  ExpectString(delimiter);
+	SkipWhitespace;
+	ExpectCP;
+      end;
+      dbg_pop;
+    end;
+
+  begin
+    dbg_push('ParseElementDecl');
+    if CheckFor('<!ELEMENT') then begin
+      ExpectWhitespace;
+      WriteLn('Element decl: ', ExpectName);
+      ExpectWhitespace;
+
+      // Get contentspec [46]
+
+      if CheckFor('EMPTY') then
+      else if CheckFor('ANY') then
+      else if CheckFor('(') then begin
+	SkipWhitespace;
+	if CheckFor('#PCDATA') then begin
+          // Parse Mixed section [51]
+  	  SkipWhitespace;
+	  if not CheckFor(')') then
+	    repeat
+	      ExpectString('|');
+	      SkipWhitespace;
+	      ExpectName;
+	    until CheckFor(')*');
+	end else begin
+	  // Parse Children section [47]
+
+	  ExpectChoiceOrSeq;
+
+	  if CheckFor('?') then
+	  else if CheckFor('*') then
+	  else if CheckFor('+') then;
+	end;
+      end else
+        RaiseExc('Invalid content specification');
+
+      SkipWhitespace;
+      ExpectString('>');
+      Result := True;
+    end else
+      Result := False;
+    dbg_pop;
+  end;
+
+  function ParseAttlistDecl: Boolean;    // [52]
+  var
+    attr: TDOMAttr;
+  begin
+    dbg_push('ParseAttlistDecl');
+    if CheckFor('<!ATTLIST') then begin
+      ExpectWhitespace;
+      ExpectName;
+      SkipWhitespace;
+      while not CheckFor('>') do begin
+        ExpectName;
+	ExpectWhitespace;
+
+        // Get AttType [54], [55], [56]
+	if CheckFor('CDATA') then
+	else if CheckFor('ID') then
+	else if CheckFor('IDREF') then
+	else if CheckFor('IDREFS') then
+	else if CheckFor('ENTITTY') then
+	else if CheckFor('ENTITIES') then
+	else if CheckFor('NMTOKEN') then
+	else if CheckFor('NMTOKENS') then
+	else if CheckFor('NOTATION') then begin   // [57], [58]
+	  ExpectWhitespace;
+	  ExpectString('(');
+	  SkipWhitespace;
+	  ExpectName;
+	  SkipWhitespace;
+	  while not CheckFor(')') do begin
+	    ExpectString('|');
+	    SkipWhitespace;
+	    ExpectName;
+	    SkipWhitespace;
+	  end;
+	end else if CheckFor('(') then begin    // [59]
+	  SkipWhitespace;
+	  GetString(Nmtoken);
+	  SkipWhitespace;
+	  while not CheckFor(')') do begin
+	    ExpectString('|');
+	    SkipWhitespace;
+	    GetString(Nmtoken);
+	    SkipWhitespace;
+          end;
+	end else
+	  RaiseExc('Invalid tokenized type');
+
+	ExpectWhitespace;
+
+	// Get DefaultDecl [60]
+	if CheckFor('#REQUIRED') then
+	else if CheckFor('#IMPLIED') then
+	else begin
+	  if CheckFor('#FIXED') then
+	    SkipWhitespace;
+	  attr := doc.CreateAttribute('');
+	  ExpectAttValue(attr);
+	end;
+
+        SkipWhitespace;
+      end;
+      Result := True;
+    end else
+      Result := False;
+    dbg_pop;
+  end;
+
+  function ParseEntityDecl: Boolean;    // [70]
+
+    function ParseEntityValue: Boolean;    // [9]
+    var
+      strdel: array[0..1] of Char;
+    begin
+      if (buf[0] <> '''') and (buf[0] <> '"') then exit(False);
+      dbg_push('ParseEntityValue');
+      strdel[0] := buf[0];
+      strdel[1] := #0;
+      Inc(buf);
+      while not CheckFor(strdel) do
+        if ParsePEReference then
+	else if ParseReference then
+	else
+	  RaiseExc('Expected reference or PE reference');
+      Result := True;
+      dbg_pop;
+    end;
+
+  begin
+    dbg_push('ParseEntityDecl');
+    if CheckFor('<!ENTITY') then begin
+      ExpectWhitespace;
+      if CheckFor('%') then begin    // [72]
+        ExpectWhitespace;
+	ExpectName;
+	ExpectWhitespace;
+	// Get PEDef [74]
+	if ParseEntityValue then
+	else if ParseExternalID then
+	else
+	  RaiseExc('Expected entity value or external ID');
+      end else begin    // [71]
+        ExpectName;
+	ExpectWhitespace;
+	// Get EntityDef [73]
+	if ParseEntityValue then
+	else begin
+	  ExpectExternalID;
+	  // Get NDataDecl [76]
+	  ExpectWhitespace;
+	  ExpectString('NDATA');
+	  ExpectWhitespace;
+	  ExpectName;
+	end;
+      end;
+      SkipWhitespace;
+      ExpectString('>');
+      Result := True;
+    end else
+      Result := False;
+    dbg_pop;
+  end;
+
+  function ParseNotationDecl: Boolean;    // [82]
+  begin
+    dbg_push('ParseNotationDecl');
+    if CheckFor('<!NOTATION') then begin
+      ExpectWhitespace;
+      ExpectName;
+      ExpectWhitespace;
+      if ParseExternalID then
+      else if CheckFor('PUBLIC') then begin    // [83]
+        ExpectWhitespace;
+	ExpectPubidLiteral;
+      end else
+        RaiseExc('Expected external or public ID');
+      SkipWhitespace;
+      ExpectString('>');
+      Result := True;
+    end else
+      Result := False;
+    dbg_pop;
+  end;
+
+begin
+  dbg_push('ParseMarkupDecl');
+  Result := False;
+  while ParseElementDecl or ParseAttlistDecl or ParseEntityDecl or
+    ParseNotationDecl or ParsePI or ParseComment or SkipWhitespace do Result := True;
+  dbg_pop;
+end;
+
+function TXMLReader.ProcessDTD(ABuf: PChar): TXMLDocument;    // [1]
+begin
+  dbg_push('ProcessDTD');
+  buf := ABuf;
+
+  doc := TXMLDocument.Create;
+  ParseMarkupDecl;
+
+  if buf[0] <> #0 then begin
+    WriteLn('=== Unparsed: ===');
+    //WriteLn(buf);
+    WriteLn(StrLen(buf), ' chars');
+  end;
+
+  Result := doc;
+  dbg_pop;
+end;
+
+function TXMLReader.ParseElement(owner: TDOMNode): Boolean;    // [39] [40] [44]
+var
+  NewElem: TDOMElement;
+
+  function ParseCharData: Boolean;    // [14]
+  var
+    s: String;
+    i: Integer;
+  begin
+    dbg_push('ParseCharData');
+    s := '';
+    while not (buf[0] in [#0, '<', '&']) do begin
+      s := s + buf[0];
+      Inc(buf);
+    end;
+    if s <> '' then begin
+      // Strip whitespace from end of s
+      i := Length(s);
+      while (i > 0) and (s[i] in [#10, #13, ' ']) do Dec(i);
+      NewElem.AppendChild(doc.CreateTextNode(Copy(s, 1, i)));
+      Result := True;
+    end else
+      Result := False;
+    dbg_pop;
+  end;
+
+  function ParseCDSect: Boolean;    // [18]
+  begin
+    dbg_push('ParseCDSect');
+    if CheckFor('<![CDATA[') then begin
+      while not CheckFor(']]>') do Inc(buf);
+      Result := True;
+    end else
+      Result := False;
+    dbg_pop;
+  end;
+
+var
+  IsEmpty: Boolean;
+  name: String;
+  oldpos: PChar;
+
+  attr: TDOMAttr;
+begin
+  dbg_push('ParseElement');
+  oldpos := buf;
+  if CheckFor('<') then begin
+    if not GetName(name) then begin
+      buf := oldpos;
+      dbg_pop;
+      exit(False);
+    end;
+
+    NewElem := doc.CreateElement(name);
+    owner.AppendChild(NewElem);
+
+    dbg_push('Processing element ' + name);
+    SkipWhitespace;
+    IsEmpty := False;
+    dbg_push('Reading until end of tag');
+    while True do begin
+      if CheckFor('/>') then begin
+        IsEmpty := True;
+        break;
+      end;
+      if CheckFor('>') then break;
+
+      // Get Attribute [41]
+      attr := doc.CreateAttribute(ExpectName);
+      NewElem.Attributes.SetNamedItem(attr);
+      ExpectEq;
+      ExpectAttValue(attr);
+
+      SkipWhitespace;
+    end;
+    dbg_pop;
+
+    if not IsEmpty then begin
+      // Get content
+      dbg_push('Reading content');
+      while SkipWhitespace or ParseCharData or ParseCDSect or ParsePI or
+        ParseComment or ParseElement(NewElem) or ParseReference do;
+
+      // Get ETag [42]
+      dbg_pop_push('Reading end tag');
+      ExpectString('</');
+      ExpectName;
+      SkipWhitespace;
+      ExpectString('>');
+      dbg_pop;
+    end;
+
+    dbg_pop;
+    Result := True;
+  end else
+    Result := False;
+  dbg_pop;
+end;
+
+procedure TXMLReader.ExpectElement(owner: TDOMNode);
+begin
+  if not ParseElement(owner) then
+    RaiseExc('Expected element');
+end;
+
+function TXMLReader.ParsePEReference: Boolean;
+begin
+  dbg_push('ParsePEReference');
+  if CheckFor('%') then begin
+    ExpectName;
+    ExpectString(';');
+    Result := True;
+  end else
+    Result := False;
+  dbg_pop;
+end;
+
+function TXMLReader.ParseReference: Boolean;    // [67] [68] [69]
+begin
+  if (buf[0] <> '&') and (buf[0] <> '%') then exit(False);
+  dbg_push('ParseReference ' + buf);
+  Inc(buf);
+  ExpectName;
+  ExpectString(';');
+  Result := True;
+  dbg_pop;
+end;
+
+procedure TXMLReader.ExpectReference;
+begin
+  if not ParseReference then
+    RaiseExc('Expected reference ("&Name;" or "%Name;")');
+end;
+
+
+function TXMLReader.ParseExternalID: Boolean;    // [75]
+
+  function GetSystemLiteral: String;
+  begin
+    dbg_push('GetSystemLiteral');
+    if buf[0] = '''' then begin
+      Inc(buf);
+      Result := '';
+      while (buf[0] <> '''') and (buf[0] <> #0) do begin
+        Result := Result + buf[0];
+	Inc(buf);
+      end;
+      ExpectString('''');
+    end else if buf[0] = '"' then begin
+      Inc(buf);
+      Result := '';
+      while (buf[0] <> '"') and (buf[0] <> #0) do begin
+        Result := Result + buf[0];
+	Inc(buf);
+      end;
+      ExpectString('"');
+    end;
+    dbg_pop;
+  end;
+
+begin
+  dbg_push('ParseExternalID');
+  if CheckFor('SYSTEM') then begin
+    ExpectWhitespace;
+    GetSystemLiteral;
+    Result := True;
+  end else if CheckFor('PUBLIC') then begin
+    ExpectWhitespace;
+    ExpectPubidLiteral;
+    ExpectWhitespace;
+    GetSystemLiteral;
+    Result := True;
+  end else
+    Result := False;
+  dbg_pop;
+end;
+
+procedure TXMLReader.ExpectExternalID;
+begin
+  if not ParseExternalID then
+    RaiseExc('Expected external ID');
+end;
+
+function TXMLReader.ParseEncodingDecl: String;    // [80]
+
+  function ParseEncName: String;
+  begin
+    dbg_push('ParseEncName');
+    if not (buf[0] in ['A'..'Z', 'a'..'z']) then
+      RaiseExc('Expected character (A-Z, a-z)');
+    Result := buf[0];
+    Inc(buf);
+    Result := Result + GetString(['A'..'Z', 'a'..'z', '0'..'9', '.', '_', '-']);
+    dbg_pop;
+  end;
+
+begin
+  dbg_push('ParseEncodingDecl');
+  Result := '';
+  SkipWhitespace;
+  if CheckFor('encoding') then begin
+    ExpectEq;
+    if buf[0] = '''' then begin
+      Inc(buf);
+      Result := ParseEncName;
+      ExpectString('''');
+    end else if buf[0] = '"' then begin
+      Inc(buf);
+      Result := ParseEncName;
+      ExpectString('"');
+    end;
+  end;
+  dbg_pop;
+end;
+
+
+function ReadXMLFile(var f: File): TXMLDocument;
+var
+  reader: TXMLReader;
+  buf: PChar;
+  BufSize: LongInt;
+begin
+  BufSize := FileSize(f) + 1;
+  if BufSize <= 1 then exit(nil);
+
+  reader := TXMLReader.Create;
+  GetMem(buf, BufSize);
+  BlockRead(f, buf^, BufSize - 1);
+  buf[BufSize - 1] := #0;
+  Result := reader.ProcessXML(buf);
+  FreeMem(buf, BufSize);
+  reader.Free;
+end;
+
+function ReadDTDFile(var f: File): TXMLDocument;
+var
+  reader: TXMLReader;
+  buf: PChar;
+  BufSize: LongInt;
+begin
+  BufSize := FileSize(f) + 1;
+  if BufSize <= 1 then exit(nil);
+
+  reader := TXMLReader.Create;
+  GetMem(buf, BufSize + 1);
+  BlockRead(f, buf^, BufSize - 1);
+  buf[BufSize - 1] := #0;
+  Result := reader.ProcessDTD(buf);
+  FreeMem(buf, BufSize);
+  reader.Free;
+end;
+
+
+end.
+
+
+{
+  $Log$
+  Revision 1.1  1999-07-09 08:35:09  michael
+  + Initial implementation by Sebastian Guenther
+
+}

fcl/xml/xmlwrite.pp

@@ -0,0 +1,184 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999 Sebastian Guenther, [email protected]
+
+    XML writing routines
+    
+    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.
+
+ **********************************************************************}
+
+{$MODE objfpc}
+
+unit xmlwrite;
+
+interface
+
+uses DOM;
+
+procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
+
+
+implementation
+
+procedure WriteElement(node: TDOMNode); forward;
+procedure WriteAttribute(node: TDOMNode); forward;
+procedure WriteText(node: TDOMNode); forward;
+procedure WriteCDATA(node: TDOMNode); forward;
+procedure WriteEntityRef(node: TDOMNode); forward;
+procedure WriteEntity(node: TDOMNode); forward;
+procedure WritePI(node: TDOMNode); forward;
+procedure WriteComment(node: TDOMNode); forward;
+procedure WriteDocument(node: TDOMNode); forward;
+procedure WriteDocumentType(node: TDOMNode); forward;
+procedure WriteDocumentFragment(node: TDOMNode); forward;
+procedure WriteNotation(node: TDOMNode); forward;
+
+
+type
+  TWriteProc = procedure(node: TDOMNode);
+const
+  WriteProcs: array[ELEMENT_NODE..NOTATION_NODE] of TWriteProc =
+    (WriteElement, WriteAttribute, WriteText, WriteCDATA, WriteEntityRef,
+     WriteEntity, WritePI, WriteComment, WriteDocument, WriteDocumentType,
+     WriteDocumentFragment, WriteNotation);
+
+procedure WriteNode(node: TDOMNode);
+begin
+  WriteProcs[node.NodeType](node);
+end;
+
+
+var
+  f: ^Text;
+  indent: String;
+
+
+procedure IncIndent;
+begin
+  indent := indent + '  ';
+end;
+
+procedure DecIndent;
+begin
+  indent := Copy(indent, 1, Length(indent) - 2);
+end;
+
+procedure WriteElement(node: TDOMNode);
+var
+  i: Integer;
+  attr, child: TDOMNode;
+begin
+  Write(f^, Indent, '<', node.NodeName);
+  for i := 0 to node.Attributes.Length - 1 do begin
+    attr := node.Attributes.Item[i];
+    Write(f^, ' ', attr.NodeName, '="', attr.NodeValue, '"');
+  end;
+  child := node.FirstChild;
+  if child = nil then
+    WriteLn(f^, '/>')
+  else begin
+    WriteLn(f^, '>');
+    IncIndent;
+    repeat
+      WriteNode(child);
+      child := child.NextSibling;
+    until child = nil;
+    DecIndent;
+    WriteLn(f^, Indent, '</', node.NodeName, '>');
+  end;
+end;
+
+procedure WriteAttribute(node: TDOMNode);
+begin
+  WriteLn('WriteAttribute');
+end;
+
+procedure WriteText(node: TDOMNode);
+begin
+  WriteLn('WriteText');
+end;
+
+procedure WriteCDATA(node: TDOMNode);
+begin
+  WriteLn('WriteCDATA');
+end;
+
+procedure WriteEntityRef(node: TDOMNode);
+begin
+  WriteLn('WriteEntityRef');
+end;
+
+procedure WriteEntity(node: TDOMNode);
+begin
+  WriteLn('WriteEntity');
+end;
+
+procedure WritePI(node: TDOMNode);
+begin
+  WriteLn('WritePI');
+end;
+
+procedure WriteComment(node: TDOMNode);
+begin
+  WriteLn('WriteComment');
+end;
+
+procedure WriteDocument(node: TDOMNode);
+begin
+  WriteLn('WriteDocument');
+end;
+
+procedure WriteDocumentType(node: TDOMNode);
+begin
+  WriteLn('WriteDocumentType');
+end;
+
+procedure WriteDocumentFragment(node: TDOMNode);
+begin
+  WriteLn('WriteDocumentFragment');
+end;
+
+procedure WriteNotation(node: TDOMNode);
+begin
+  WriteLn('WriteNotation');
+end;
+
+
+procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
+var
+  child: TDOMNode;
+begin
+  f := @AFile;
+  Write(f^, '<?xml version="');
+  if doc.XMLVersion <> '' then Write(f^, doc.XMLVersion)
+  else Write(f^, '1.0');
+  Write(f^, '"');
+  if doc.Encoding <> '' then Write(f^, ' encoding="', doc.Encoding, '"');
+  WriteLn(f^, '?>');
+
+  indent := '';
+
+  child := doc.FirstChild;
+  while child <> nil do begin
+    WriteNode(child);
+    child := child.NextSibling;
+  end;
+end;
+
+
+end.
+
+
+{
+  $Log$
+  Revision 1.1  1999-07-09 08:35:09  michael
+  + Initial implementation by Sebastian Guenther
+
+}