-- $Date: 2003/12/30 05:50:43 $
-- $Revision: 1.9 $
-- $Author: jcrocholl $

with Ada.Unchecked_Deallocation;
use Ada;

with Parsers;
use Parsers;

package body XML_Parsers is

   -- Open an XML parser to read from current input.
   -- Useful to read from a pipe.
   function Current_Input
     return XML_Parser is -- The newly created XML_Parser.
   begin
      return new XML_Parser_Record'(Parser => Parsers.Current_Input);
   end Current_Input;

   function Open
     (File_Name : in String-- The file to read from.
     return XML_Parser is    -- The newly created XML_Parser.
   begin
      return new XML_Parser_Record'(Parser => Parsers.Open(File_Name));
   end Open;

   procedure Free is
     new Unchecked_Deallocation(XML_Parser_Record, XML_Parser);

   procedure Close
     (X : in out XML_Parser) is -- The XML_Parser to be closed.
   begin
      Parsers.Close(X.Parser);
      Free(X);
      X := null;
   end Close;

   -- Read the name of the next element on the same XML hierarchy
   -- level. The parser must be positioned at the start of the
   -- element, whitespace permitted.
   function Next_Element
     (X : in XML_Parser-- The parser to read from.
     return String       -- The element name.
   is
      P : Parser := X.Parser;
   begin
      if not Skip(P, '<') then Error(P, "expecting '<'"); end if;
      declare
         Result : String := Read_Word(P);
      begin
         return Result;
      end;
   end Next_Element;

   -- Read the name of the next attribute in the current element
   -- tag. The parser must be positioned at the start of the
   -- attribute, whitespace permitted.
   function Next_Attribute
     (X : in XML_Parser-- The parser to read from.
     return String       -- The attribute name.
   is
      P : Parser := X.Parser;
   begin
      Skip_Any(P, Whitespace);
      declare
         Result : String := Read_Word(P);
      begin
         return Result;
      end;
   end Next_Attribute;

   -- Read the associated value of the most recently read attribute
   -- name. The parser must be positioned at the start of the
   -- attribute value (after the '='), whitespace permitted.
   function Attribute_Value
     (X : in XML_Parser-- The parser to read from.
     return String       -- The attribute value.
   is
      P : Parser := X.Parser;
   begin
      Skip_Any(P, Whitespace);
      declare
         Result : String := Read_Word(P, Whitespace & '=');
      begin
         return Result;
      end;
   end Attribute_Value;

   -- Go down one level in the document hierarchy.
   procedure Descend
     (X : in XML_Parser) is -- The parser to descend.
   begin
      null;
   end Descend;

   -- Go up one level in the document hierarchy.
   procedure Ascend
     (X : in XML_Parser) is -- The parser to ascend.
   begin
      null;
   end Ascend;

   -- Emit a warning about XML or document syntax.
   procedure Warning
     (X       : in XML_Parser-- Get error location from this parser.
      Message : in String) is  -- Error message text.
   begin
      Warning(X.Parser, Message);
   end Warning;

   -- Emit an error about XML or document syntax.
   procedure Error
     (X       : in XML_Parser-- Get error location from this parser.
      Message : in String) is  -- Error message text.
   begin
      Error(X.Parser, Message);
   end Error;

end XML_Parsers;