Browse Source

* the units DOM, XMLRead and XMLWrite now compile with Delphi without
modifications as well

sg 22 years ago
parent
commit
7b1d508f3a
3 changed files with 182 additions and 128 deletions
  1. 49 36
      fcl/xml/dom.pp
  2. 110 78
      fcl/xml/xmlread.pp
  3. 23 14
      fcl/xml/xmlwrite.pp

+ 49 - 36
fcl/xml/dom.pp

@@ -3,7 +3,7 @@
     This file is part of the Free Component Library
 
     Implementation of DOM interfaces
-    Copyright (c) 1999-2000 by Sebastian Guenther, [email protected]
+    Copyright (c) 1999-2003 by Sebastian Guenther, [email protected]
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -38,25 +38,6 @@ 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
 // -------------------------------------------------------
@@ -72,7 +53,6 @@ type
 //   DOMException
 // -------------------------------------------------------
 
-
 const
 
   // DOM Level 1 exception codes:
@@ -184,6 +164,24 @@ const
 
 type
 
+  TDOMImplementation = class;
+  TDOMDocumentFragment = class;
+  TDOMDocument = class;
+  TDOMNode = class;
+  TDOMNodeList = class;
+  TDOMNamedNodeMap = class;
+  TDOMCharacterData = class;
+  TDOMAttr = class;
+  TDOMElement = class;
+  TDOMText = class;
+  TDOMComment = class;
+  TDOMCDATASection = class;
+  TDOMDocumentType = class;
+  TDOMNotation = class;
+  TDOMEntity = class;
+  TDOMEntityReference = class;
+  TDOMProcessingInstruction = class;
+
   TRefClass = class
   protected
     RefCounter: LongInt;
@@ -229,10 +227,11 @@ type
     function RemoveChild(OldChild: TDOMNode): TDOMNode; virtual;
     function AppendChild(NewChild: TDOMNode): TDOMNode; virtual;
     function HasChildNodes: Boolean; virtual;
-    function CloneNode(deep: Boolean): TDOMNode;
+    function CloneNode(deep: Boolean): TDOMNode; overload;
 
     // Extensions to DOM interface:
-    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; virtual;
+    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
+      overload; virtual;
     function FindNode(const ANodeName: DOMString): TDOMNode;
   end;
 
@@ -376,13 +375,13 @@ type
 
   TXMLDocument = class(TDOMDocument)
   public
+    // These fields are extensions to the DOM interface:
+    XMLVersion, Encoding, StylesheetType, StylesheetHRef: DOMString;
+
     function CreateCDATASection(const data: DOMString): TDOMCDATASection; override;
     function CreateProcessingInstruction(const target, data: DOMString):
       TDOMProcessingInstruction; override;
     function CreateEntityReference(const name: DOMString): TDOMEntityReference; override;
-
-    // Extensions to DOM interface:
-    XMLVersion, Encoding, StylesheetType, StylesheetHRef: DOMString;
   end;
 
 
@@ -399,7 +398,8 @@ type
 
     constructor Create(AOwner: TDOMDocument);
   public
-    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; override;
+    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
+      overload; override;
     property Name: DOMString read FNodeName;
     property Specified: Boolean read FSpecified;
     property Value: DOMString read GetNodeValue write SetNodeValue;
@@ -418,7 +418,8 @@ type
     constructor Create(AOwner: TDOMDocument); virtual;
   public
     destructor Destroy; override;
-    function  CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; override;
+    function  CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
+      overload; override;
     property  TagName: DOMString read FNodeName;
     function  GetAttribute(const name: DOMString): DOMString;
     procedure SetAttribute(const name, value: DOMString);
@@ -443,7 +444,8 @@ type
   protected
     constructor Create(AOwner: TDOMDocument);
   public
-    function  CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; override;
+    function  CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
+      overload; override;
     function SplitText(offset: LongWord): TDOMText;
   end;
 
@@ -456,7 +458,8 @@ type
   protected
     constructor Create(AOwner: TDOMDocument);
   public
-    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; override;
+    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
+      overload; override;
   end;
 
 
@@ -468,7 +471,8 @@ type
   protected
     constructor Create(AOwner: TDOMDocument);
   public
-    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; override;
+    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
+      overload; override;
   end;
 
 
@@ -482,7 +486,8 @@ type
 
     constructor Create(AOwner: TDOMDocument);
   public
-    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; override;
+    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
+      overload; override;
     property Name: DOMString read FNodeName;
     property Entities: TDOMNamedNodeMap read FEntities;
     property Notations: TDOMNamedNodeMap read FEntities;
@@ -499,7 +504,8 @@ type
 
     constructor Create(AOwner: TDOMDocument);
   public
-    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; override;
+    function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
+      overload; override;
     property PublicID: DOMString read FPublicID;
     property SystemID: DOMString read FSystemID;
   end;
@@ -936,8 +942,11 @@ var
   i: Integer;
 begin
   for i := 0 to Count - 1 do
-    if Item[i].NodeName = name then
-      exit(Item[i]);
+  begin
+    Result := Item[i];
+    if Result.NodeName = name then
+      exit;
+  end;
   Result := nil;
 end;
 
@@ -1501,7 +1510,11 @@ end.
 
 {
   $Log$
-  Revision 1.11  2002-12-11 21:06:07  sg
+  Revision 1.12  2003-01-15 21:59:55  sg
+  * the units DOM, XMLRead and XMLWrite now compile with Delphi without
+    modifications as well
+
+  Revision 1.11  2002/12/11 21:06:07  sg
   * Small cleanups
   * Replaced htmldoc unit with dom_html unit
   * Added SAX parser framework and SAX HTML parser

+ 110 - 78
fcl/xml/xmlread.pp

@@ -3,7 +3,7 @@
     This file is part of the Free Component Library
 
     XML reading routines.
-    Copyright (c) 1999-2002 by Sebastian Guenther, [email protected]
+    Copyright (c) 1999-2003 by Sebastian Guenther, [email protected]
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -14,8 +14,6 @@
 
  **********************************************************************}
 
-{$MODE objfpc}
-{$H+}
 
 unit XMLRead;
 
@@ -29,22 +27,25 @@ type
 
 
 procedure ReadXMLFile(var ADoc: TXMLDocument; const AFilename: String);
-procedure ReadXMLFile(var ADoc: TXMLDocument; var f: File);
-procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream);
+  overload;
+procedure ReadXMLFile(var ADoc: TXMLDocument; var f: File); overload;
+procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream); overload;
 procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream;
-  const AFilename: String);
+  const AFilename: String); overload;
 
 procedure ReadXMLFragment(AParentNode: TDOMNode; const AFilename: String);
-procedure ReadXMLFragment(AParentNode: TDOMNode; var f: File);
-procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream);
+  overload;
+procedure ReadXMLFragment(AParentNode: TDOMNode; var f: File); overload;
+procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream); overload;
 procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream;
-  const AFilename: String);
+  const AFilename: String); overload;
 
 procedure ReadDTDFile(var ADoc: TXMLDocument; const AFilename: String);
-procedure ReadDTDFile(var ADoc: TXMLDocument; var f: File);
-procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream);
+  overload;
+procedure ReadDTDFile(var ADoc: TXMLDocument; var f: File); overload;
+procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream); overload;
 procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream;
-  const AFilename: String);
+  const AFilename: String); overload;
 
 
 // =======================================================
@@ -184,7 +185,7 @@ begin
       GetMem(s2, Length(s) + 1);
       StrLCopy(s2, buf, Length(s));
       s3 := StrPas(s2);
-      FreeMem(s2, Length(s) + 1);
+      FreeMem(s2);
       RaiseExc('Expected "' + s + '", found "' + s3 + '"');
     end;
   Inc(buf, Length(s));
@@ -213,8 +214,6 @@ begin
 end;
 
 procedure TXMLReader.ProcessXML(ABuf: PChar; AFilename: String);    // [1]
-var
-  LastNodeBeforeDoc: TDOMNode;
 begin
   buf := ABuf;
   BufStart := ABuf;
@@ -222,20 +221,11 @@ begin
 
   doc := TXMLReaderDocument.Create;
   ExpectProlog;
-  LastNodeBeforeDoc := doc.LastChild;
   ExpectElement(doc);
   ParseMisc(doc);
 
   if buf[0] <> #0 then
     RaiseExc('Text after end of document element found');
-
-  {
-  if buf[0] <> #0 then begin
-    WriteLn('=== Unparsed: ===');
-    //WriteLn(buf);
-    WriteLn(StrLen(buf), ' chars');
-  end;
-  }
 end;
 
 procedure TXMLReader.ProcessFragment(AOwner: TDOMNode; ABuf: PChar;
@@ -350,7 +340,7 @@ var
 begin
   if CheckFor('<?') then begin
     StrLCopy(checkbuf, buf, 3);
-    if UpCase(StrPas(checkbuf)) = 'XML' then
+    if UpperCase(StrPas(checkbuf)) = 'XML' then
       RaiseExc('"<?xml" processing instruction not allowed here');
     ExpectName;
     if SkipWhitespace then
@@ -1030,13 +1020,19 @@ begin
     exit;
 
   GetMem(buf, BufSize);
-  BlockRead(f, buf^, BufSize - 1);
-  buf[BufSize - 1] := #0;
-  Reader := TXMLReader.Create;
-  Reader.ProcessXML(buf, Filerec(f).name);
-  FreeMem(buf, BufSize);
-  ADoc := TXMLDocument(Reader.doc);
-  Reader.Free;
+  try
+    BlockRead(f, buf^, BufSize - 1);
+    buf[BufSize - 1] := #0;
+    Reader := TXMLReader.Create;
+    try
+      Reader.ProcessXML(buf, TFileRec(f).name);
+      ADoc := TXMLDocument(Reader.doc);
+    finally
+      Reader.Free;
+    end;
+  finally
+    FreeMem(buf);
+  end;
 end;
 
 procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream;
@@ -1050,13 +1046,19 @@ begin
     exit;
 
   GetMem(buf, f.Size + 1);
-  f.Read(buf^, f.Size);
-  buf[f.Size] := #0;
-  Reader := TXMLReader.Create;
-  Reader.ProcessXML(buf, AFilename);
-  FreeMem(buf, f.Size + 1);
-  ADoc := TXMLDocument(Reader.doc);
-  Reader.Free;
+  try
+    f.Read(buf^, f.Size);
+    buf[f.Size] := #0;
+    Reader := TXMLReader.Create;
+    try
+      Reader.ProcessXML(buf, AFilename);
+      ADoc := TXMLDocument(Reader.doc);
+    finally
+      Reader.Free;
+    end;
+  finally
+    FreeMem(buf);
+  end;
 end;
 
 procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream);
@@ -1066,7 +1068,7 @@ end;
 
 procedure ReadXMLFile(var ADoc: TXMLDocument; const AFilename: String);
 var
-  Stream: TFileStream;
+  Stream: TStream;
 begin
   ADoc := nil;
   Stream := TFileStream.Create(AFilename, fmOpenRead);
@@ -1089,13 +1091,19 @@ begin
     exit;
 
   GetMem(buf, BufSize);
-  BlockRead(f, buf^, BufSize - 1);
-  buf[BufSize - 1] := #0;
-  Reader := TXMLReader.Create;
-  Reader.Doc := AParentNode.OwnerDocument;
-  Reader.ProcessFragment(AParentNode, buf, Filerec(f).name);
-  FreeMem(buf, BufSize);
-  Reader.Free;
+  try
+    BlockRead(f, buf^, BufSize - 1);
+    buf[BufSize - 1] := #0;
+    Reader := TXMLReader.Create;
+    try
+      Reader.Doc := AParentNode.OwnerDocument;
+      Reader.ProcessFragment(AParentNode, buf, TFileRec(f).name);
+    finally
+      Reader.Free;
+    end;
+  finally
+    FreeMem(buf);
+  end;
 end;
 
 procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream;
@@ -1108,13 +1116,19 @@ begin
     exit;
 
   GetMem(buf, f.Size + 1);
-  f.Read(buf^, f.Size);
-  buf[f.Size] := #0;
-  Reader := TXMLReader.Create;
-  Reader.Doc := AParentNode.OwnerDocument;
-  Reader.ProcessFragment(AParentNode, buf, AFilename);
-  FreeMem(buf, f.Size + 1);
-  Reader.Free;
+  try
+    f.Read(buf^, f.Size);
+    buf[f.Size] := #0;
+    Reader := TXMLReader.Create;
+    Reader.Doc := AParentNode.OwnerDocument;
+    try
+      Reader.ProcessFragment(AParentNode, buf, AFilename);
+    finally
+      Reader.Free;
+    end;
+  finally
+    FreeMem(buf);
+  end;
 end;
 
 procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream);
@@ -1124,7 +1138,7 @@ end;
 
 procedure ReadXMLFragment(AParentNode: TDOMNode; const AFilename: String);
 var
-  Stream: TFileStream;
+  Stream: TStream;
 begin
   Stream := TFileStream.Create(AFilename, fmOpenRead);
   try
@@ -1143,16 +1157,23 @@ var
 begin
   ADoc := nil;
   BufSize := FileSize(f) + 1;
-  if BufSize <= 1 then exit;
-
-  GetMem(buf, BufSize + 1);
-  BlockRead(f, buf^, BufSize - 1);
-  buf[BufSize - 1] := #0;
-  Reader := TXMLReader.Create;
-  Reader.ProcessDTD(buf, Filerec(f).name);
-  FreeMem(buf, BufSize);
-  ADoc := TXMLDocument(Reader.doc);
-  Reader.Free;
+  if BufSize <= 1 then
+    exit;
+
+  GetMem(buf, BufSize);
+  try
+    BlockRead(f, buf^, BufSize - 1);
+    buf[BufSize - 1] := #0;
+    Reader := TXMLReader.Create;
+    try
+      Reader.ProcessDTD(buf, TFileRec(f).name);
+      ADoc := TXMLDocument(Reader.doc);
+    finally
+      Reader.Free;
+    end;
+  finally
+    FreeMem(buf);
+  end;
 end;
 
 procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream;
@@ -1162,16 +1183,23 @@ var
   buf: PChar;
 begin
   ADoc := nil;
-  if f.Size = 0 then exit;
+  if f.Size = 0 then
+    exit;
 
   GetMem(buf, f.Size + 1);
-  f.Read(buf^, f.Size);
-  buf[f.Size] := #0;
-  Reader := TXMLReader.Create;
-  Reader.ProcessDTD(buf, AFilename);
-  FreeMem(buf, f.Size + 1);
-  ADoc := TXMLDocument(Reader.doc);
-  Reader.Free;
+  try
+    f.Read(buf^, f.Size);
+    buf[f.Size] := #0;
+    Reader := TXMLReader.Create;
+    try
+      Reader.ProcessDTD(buf, AFilename);
+      ADoc := TXMLDocument(Reader.doc);
+    finally
+      Reader.Free;
+    end;
+  finally
+    FreeMem(buf);
+  end;
 end;
 
 procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream);
@@ -1181,14 +1209,14 @@ end;
 
 procedure ReadDTDFile(var ADoc: TXMLDocument; const AFilename: String);
 var
-  stream: TFileStream;
+  Stream: TStream;
 begin
   ADoc := nil;
-  stream := TFileStream.Create(AFilename, fmOpenRead);
+  Stream := TFileStream.Create(AFilename, fmOpenRead);
   try
-    ReadDTDFile(ADoc, stream, AFilename);
+    ReadDTDFile(ADoc, Stream, AFilename);
   finally
-    stream.Free;
+    Stream.Free;
   end;
 end;
 
@@ -1198,7 +1226,11 @@ end.
 
 {
   $Log$
-  Revision 1.7  2002-09-21 19:22:38  sg
+  Revision 1.8  2003-01-15 21:59:55  sg
+  * the units DOM, XMLRead and XMLWrite now compile with Delphi without
+    modifications as well
+
+  Revision 1.7  2002/09/21 19:22:38  sg
   * Added procedures to process XML fragments only (e.g. for merging them
     into an existing DOM document)
 

+ 23 - 14
fcl/xml/xmlwrite.pp

@@ -3,7 +3,7 @@
     This file is part of the Free Component Library
 
     XML writing routines
-    Copyright (c) 1999-2002 by Sebastian Guenther, [email protected]
+    Copyright (c) 1999-2003 by Sebastian Guenther, [email protected]
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -17,20 +17,17 @@
 
 unit XMLWrite;
 
-{$MODE objfpc}
-{$H+}
-
 interface
 
 uses Classes, DOM;
 
-procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String);
-procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
-procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream);
+procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String); overload;
+procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text); overload;
+procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream); overload;
 
-procedure WriteXML(Node: TDOMNode; const AFileName: String);
-procedure WriteXML(Node: TDOMNode; var AFile: Text);
-procedure WriteXML(Node: TDOMNode; AStream: TStream);
+procedure WriteXML(Node: TDOMNode; const AFileName: String); overload;
+procedure WriteXML(Node: TDOMNode; var AFile: Text); overload;
+procedure WriteXML(Node: TDOMNode; AStream: TStream); overload;
 
 
 // ===================================================================
@@ -62,9 +59,15 @@ type
 
 const
   WriteProcs: array[ELEMENT_NODE..NOTATION_NODE] of TWriteNodeProc =
+{$IFDEF FPC}
     (@WriteElement, @WriteAttribute, @WriteText, @WriteCDATA, @WriteEntityRef,
      @WriteEntity, @WritePI, @WriteComment, @WriteDocument, @WriteDocumentType,
      @WriteDocumentFragment, @WriteNotation);
+{$ELSE}
+    (WriteElement, WriteAttribute, WriteText, WriteCDATA, WriteEntityRef,
+     WriteEntity, WritePI, WriteComment, WriteDocument, WriteDocumentType,
+     WriteDocumentFragment, WriteNotation);
+{$ENDIF}
 
 procedure WriteNode(node: TDOMNode);
 begin
@@ -99,14 +102,16 @@ end;
 procedure Stream_Write(s: String);
 begin
   if Length(s) > 0 then
-    stream.Write(s[1], Length(s));
+    Stream.Write(s[1], Length(s));
 end;
 
 procedure Stream_WriteLn(s: String);
+const
+  LF: Char = #10;
 begin
   if Length(s) > 0 then
-    stream.Write(s[1], Length(s));
-  stream.WriteByte(10);
+    Stream.Write(s[1], Length(s));
+  Stream.Write(LF, 1);
 end;
 
 
@@ -420,7 +425,11 @@ end.
 
 {
   $Log$
-  Revision 1.10  2002-11-30 16:04:34  sg
+  Revision 1.11  2003-01-15 21:59:55  sg
+  * the units DOM, XMLRead and XMLWrite now compile with Delphi without
+    modifications as well
+
+  Revision 1.10  2002/11/30 16:04:34  sg
   * Stream parameters are not "var" anymore (stupid copy&paste bug)
 
   Revision 1.9  2002/09/20 11:36:51  sg