File : tree_readers.adb


-----------------------------------------------------------------------

--                XML/Ada - An XML suite for Ada95                   --

--                                                                   --

--                       Copyright (C) 2001                          --

--                            ACT-Europe                             --

--                       Author: Emmanuel Briot                      --

--                                                                   --

-- This library is free software; you can redistribute it and/or     --

-- modify it under the terms of the GNU General Public               --

-- License as published by the Free Software Foundation; either      --

-- version 2 of the License, or (at your option) any later version.  --

--                                                                   --

-- This library is distributed in the hope that it will be useful,   --

-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --

-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --

-- General Public License for more details.                          --

--                                                                   --

-- You should have received a copy of the GNU General Public         --

-- License along with this library; if not, write to the             --

-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --

-- Boston, MA 02111-1307, USA.                                       --

--                                                                   --

-- As a special exception, if other files instantiate generics from  --

-- this unit, or you link this unit with other files to produce an   --

-- executable, this  unit  does not  by itself cause  the resulting  --

-- executable to be covered by the GNU General Public License. This  --

-- exception does not however invalidate any other reasons why the   --

-- executable file  might be covered by the  GNU Public License.     --

-----------------------------------------------------------------------


with Sax.Attributes;       use Sax.Attributes;
with Unicode;              use Unicode;
with Unicode.CES;          use Unicode.CES;
with DOM.Core.Nodes;       use DOM.Core.Nodes;
with DOM.Core.Documents;   use DOM.Core.Documents;
with DOM.Core.Elements;    use DOM.Core.Elements;

package body Tree_Readers is
   --------------------

   -- Start_Document --

   --------------------


   procedure Start_Document (Handler : in out Tree_Reader) is
      Implementation : DOM_Implementation;
   begin
      Handler.Tree := Create_Document (Implementation);
      Handler.Current_Node := Handler.Tree;
   end Start_Document;

   -------------------

   -- Start_Element --

   -------------------


   procedure Start_Element
     (Handler       : in out Tree_Reader;
      Namespace_URI : Unicode.CES.Byte_Sequence := "";
      Local_Name    : Unicode.CES.Byte_Sequence := "";
      Qname         : Unicode.CES.Byte_Sequence := "";
      Atts          : Sax.Attributes.Attributes'Class) is
   begin
      Handler.Current_Node := Append_Child
        (Handler.Current_Node,
         Create_Element_NS (Handler.Tree,
                            Namespace_URI => Namespace_URI,
                            Qualified_Name => Qname));

      --  Insert the attributes in the right order.

      for J in 0 .. Get_Length (Atts) - 1 loop
         Set_Attribute_NS
           (Handler.Current_Node,
            Get_URI (Atts, J),
            Get_Qname (Atts, J),
            Get_Value (Atts, J));
      end loop;
   end Start_Element;

   -----------------

   -- End_Element --

   -----------------


   procedure End_Element
     (Handler : in out Tree_Reader;
      Namespace_URI : Unicode.CES.Byte_Sequence := "";
      Local_Name    : Unicode.CES.Byte_Sequence := "";
      Qname         : Unicode.CES.Byte_Sequence := "") is
   begin
      Handler.Current_Node := Parent_Node (Handler.Current_Node);
   end End_Element;

   ----------------

   -- Characters --

   ----------------


   procedure Characters
     (Handler : in out Tree_Reader; Ch : Unicode.CES.Byte_Sequence)
   is
      Tmp : Node;
   begin
      Tmp := Append_Child
        (Handler.Current_Node, Create_Text_Node (Handler.Tree, Ch));
   end Characters;

   --------------------------

   -- Ignorable_Whitespace --

   --------------------------


   procedure Ignorable_Whitespace
     (Handler : in out Tree_Reader; Ch : Unicode.CES.Byte_Sequence)
   is
      Tmp : Node;
   begin
      --  Ignore these white spaces at the toplevel

      if Handler.Current_Node /= Handler.Tree then
         Tmp := Append_Child
           (Handler.Current_Node, Create_Text_Node (Handler.Tree, Ch));
      end if;
   end Ignorable_Whitespace;

   ----------------------------

   -- Processing_Instruction --

   ----------------------------


   procedure Processing_Instruction
     (Handler : in out Tree_Reader;
      Target  : Unicode.CES.Byte_Sequence;
      Data    : Unicode.CES.Byte_Sequence)
   is
      Tmp : Node;
   begin
      if not Handler.In_DTD then
         Tmp := Append_Child
           (Handler.Current_Node,
            Create_Processing_Instruction (Handler.Tree, Target, Data));
      end if;
   end Processing_Instruction;

   --------------

   -- Get_Tree --

   --------------


   function Get_Tree (Read : Tree_Reader) return Document is
   begin
      return Read.Tree;
   end Get_Tree;

   ---------------

   -- Start_DTD --

   ---------------


   procedure Start_DTD
     (Handler   : in out Tree_Reader;
      Name      : Unicode.CES.Byte_Sequence;
      Public_Id : Unicode.CES.Byte_Sequence := "";
      System_Id : Unicode.CES.Byte_Sequence := "") is
   begin
      Handler.In_DTD := True;
   end Start_DTD;

   -------------

   -- End_DTD --

   -------------


   procedure End_DTD (Handler : in out Tree_Reader) is
   begin
      Handler.In_DTD := False;
   end End_DTD;

   -----------

   -- Error --

   -----------


   procedure Error
     (Handler : in out Tree_Reader;
      Except  : Sax.Exceptions.Sax_Parse_Exception'Class) is
   begin
      Fatal_Error (Handler, Except);
   end Error;

   -------------

   -- Warning --

   -------------


   procedure Warning
     (Handler : in out Tree_Reader;
      Except : Sax.Exceptions.Sax_Parse_Exception'Class) is
   begin
      Fatal_Error (Handler, Except);
   end Warning;

   ----------

   -- Free --

   ----------


   procedure Free (Read : in out Tree_Reader) is
   begin
      Free (Read.Tree);
      Read.Tree := null;
   end Free;

end Tree_Readers;