File : sax-readers.adb


with Ada.Exceptions;            use Ada.Exceptions;
with Ada.Text_IO;               use Ada.Text_IO;
with Input_Sources.File;        use Input_Sources.File;
with Input_Sources.Strings;     use Input_Sources.Strings;
with Input_Sources;             use Input_Sources;
with Sax.Attributes;            use Sax.Attributes;
with Sax.Attributes;            use Sax.Attributes;
with Sax.Encodings;             use Sax.Encodings;
with Sax.Exceptions;            use Sax.Exceptions;
with Sax.Locators;              use Sax.Locators;
with Sax.Models;                use Sax.Models;
with Unchecked_Deallocation;
with Unicode.CES.Basic_8bit;    use Unicode.CES.Basic_8bit;
with Unicode.CES;               use Unicode.CES;
with Unicode.Names.Basic_Latin; use Unicode.Names.Basic_Latin;
with Unicode;                   use Unicode;

package body Sax.Readers is

   use Entity_Table, Attributes_Table, Notations_Table;

   Debug_Lexical : constant Boolean := False;
   Debug_Input : constant Boolean := False;
   --  Set to True if you want to debug this package


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

   -- Tokens --

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


   type Token_Type is
     (Double_String_Delimiter, --  "

      Single_String_Delimiter, --  '

      Comment,                 --  <!--...--> (Data is the comment)

      Start_Of_Tag,            --  <

      Start_Of_End_Tag,        --  </

      End_Of_Start_Tag,        --  />

      Start_Of_PI,             --  <?

      End_Of_PI,               --  ?>

      End_Of_Tag,              --  >

      Equal,                   --  =  (in tags)

      Colon,                   --  :  (in tags)

      Open_Paren,              --  (  (while parsing content model in ATTLIST)

      Internal_DTD_Start,      --  [  (while in DTD)

      Internal_DTD_End,        --  ]  (while in DTD)

      Include,                 --  <![INCLUDE[

      Ignore,                  --  <![IGNORE[

      Start_Conditional,       --  <![

      End_Conditional,         --  ]]>

      Space,                   --  Any number of spaces (Data is the spaces)

      Text,                    --  any text  (Data is the identifier)

      Name,                    --  same as text, but contains only valid

      --  name characters

      Cdata_Section,           --  <![CDATA

      Doctype_Start,           --  <!DOCTYPE

      System,                  --  SYSTEM  (while in DTD)

      Public,                  --  PUBLIC  (while in DTD)

      Ndata,                   --  NDATA   (while in DTD)

      Any,                     --  ANY (while in DTD)

      Empty,                   --  EMPTY (while in DTD)

      Notation,                --  NOTATION (while in DTD or ATTLIST)

      Entity_Def,              --  <!ENTITY (while in DTD)

      Element_Def,             --  <!ELEMENT (while in DTD)

      Attlist_Def,             --  <!ATTLIST (while in DTD)

      Id_Type,                 --  ID (while in ATTLIST)      Data is "ID"

      Idref,                   --  IDREF (while in ATTLIST)   Data is "IDREF"

      Idrefs,                  --  IDREFS (while in ATTLIST)  Data is "IDREFS"

      Cdata,                   --  CDATA (while in ATTLIST)   Data is "CDATA"

      Entity,                  --  ENTITY (while in ATTLIST)  Data is "ENTITY"

      Entities,                --  ENTITIES (while in ATTLIST) Data="ENTITIES"

      Nmtoken,                 --  NMTOKEN (while in ATTLIST) Data="NMTOKEN"

      Nmtokens,                --  NMTOKENS (while in ATTLIST) Data="NMTOKENS"

      Required,                --  REQUIRED (while in ATTLIST) Data="#REQUIRED"

      Implied,                 --  IMPLIED (while in ATTLIST) Data="#IMPLIED"

      Fixed,                   --  FIXED (while in ATTLIST) Data="#FIXED"

      End_Of_Input             --  End of input was seen.

     );

   type Token is record
      Typ : Token_Type;
      First, Last : Natural;  --   Indexes in the buffer

      Line, Column : Natural; --   Line and col within the current stream

      Input_Id : Natural;     --   Id of the input source in which Token was

                              --   read.

   end record;

   Null_Token : constant Token := (End_Of_Input, 1, 0, 0, 0, 0);

   Default_State : constant Parser_State :=
     (Name => "Def",
      Ignore_Special => False,
      Detect_End_Of_PI => False,
      Greater_Special => False,
      Less_Special => False,
      Expand_Param_Entities => False,
      Expand_Entities => True,
      Expand_Character_Ref => True,
      In_DTD => False,
      Recognize_External => False,
      Handle_Strings => False,
      In_Tag => False,
      Report_Parenthesis => False,
      In_Attlist => False);
   Attr_Value_State : constant Parser_State :=
     (Name => "Att",
      Ignore_Special => True,
      Detect_End_Of_PI => False,
      Greater_Special => False,
      Less_Special => True,
      Expand_Param_Entities => False,
      Expand_Entities => True,
      Expand_Character_Ref => True,
      In_DTD => False,
      Recognize_External => False,
      Handle_Strings => True,
      In_Tag => False,
      Report_Parenthesis => False,
      In_Attlist => False);
   Non_Interpreted_String_State : constant Parser_State :=
     (Name => "Str",
      Ignore_Special => True,
      Detect_End_Of_PI => False,
      Greater_Special => False,
      Less_Special => False,
      Expand_Param_Entities => False,
      Expand_Entities => False,
      Expand_Character_Ref => False,
      In_DTD => False,
      Recognize_External => False,
      Handle_Strings => True,
      In_Tag => False,
      Report_Parenthesis => False,
      In_Attlist => False);
   DTD_State : constant Parser_State :=
     (Name => "DTD",
      Ignore_Special => False,
      Detect_End_Of_PI => False,
      Greater_Special => True,
      Less_Special => False,
      Expand_Param_Entities => True,
      Expand_Entities => True,
      Expand_Character_Ref => True,
      In_DTD => True,
      Recognize_External => True,
      Handle_Strings => True,
      In_Tag => False,
      Report_Parenthesis => False,
      In_Attlist => False);
   PI_State : constant Parser_State :=
     (Name => "PI ",
      Ignore_Special => True,
      Detect_End_Of_PI => True,
      Greater_Special => False,
      Less_Special => False,
      Expand_Param_Entities => False,
      Expand_Entities => False,
      Expand_Character_Ref => False,
      In_DTD => False,
      Recognize_External => False,
      Handle_Strings => True,
      In_Tag => False,
      Report_Parenthesis => False,
      In_Attlist => False);
   Entity_Def_State : constant Parser_State :=
     (Name => "Ent",
      Ignore_Special => False,
      Detect_End_Of_PI => False,
      Greater_Special => True,
      Less_Special => False,
      Expand_Param_Entities => False,
      Expand_Entities => False,
      Expand_Character_Ref => True,
      In_DTD => True,
      Recognize_External => True,
      Handle_Strings => True,
      In_Tag => False,
      Report_Parenthesis => False,
      In_Attlist => False);
   Element_Def_State : constant Parser_State :=
     (Name => "Ele",
      Ignore_Special => False,
      Detect_End_Of_PI => False,
      Greater_Special => True,
      Less_Special => False,
      Expand_Param_Entities => True,
      Expand_Entities => False,
      Expand_Character_Ref => True,
      In_DTD => True,
      Recognize_External => True,
      Handle_Strings => True,
      In_Tag => False,
      Report_Parenthesis => True,
      In_Attlist => False);
   Attribute_Def_State : constant Parser_State :=
     (Name => "AtD",
      Ignore_Special => False,
      Detect_End_Of_PI => False,
      Greater_Special => True,
      Less_Special => False,
      Expand_Param_Entities => True,
      Expand_Entities => False,
      Expand_Character_Ref => True,
      In_DTD => True,
      Recognize_External => False,
      Handle_Strings => True,
      In_Tag => True,
      Report_Parenthesis => True,
      In_Attlist => True);
   Entity_Str_Def_State : constant Parser_State :=
     (Name => "EtS",
      Ignore_Special => True,
      Detect_End_Of_PI => False,
      Greater_Special => False,
      Less_Special => False,
      Expand_Param_Entities => True,
      Expand_Entities => False,
      Expand_Character_Ref => True,
      In_DTD => True,
      Recognize_External => False,
      Handle_Strings => True,
      In_Tag => False,
      Report_Parenthesis => False,
      In_Attlist => False);
   Attlist_Str_Def_State : constant Parser_State :=
     (Name => "AtS",
      Ignore_Special => True,
      Detect_End_Of_PI => False,
      Greater_Special => False,
      Less_Special => False,
      Expand_Param_Entities => True,
      Expand_Entities => True,
      Expand_Character_Ref => True,
      In_DTD => True,
      Recognize_External => False,
      Handle_Strings => True,
      In_Tag => False,
      Report_Parenthesis => False,
      In_Attlist => False);
   Tag_State : constant Parser_State :=
     (Name => "Tag",
      Ignore_Special => False,
      Greater_Special => True,
      Less_Special => False,
      Detect_End_Of_PI => False,
      Expand_Param_Entities => False,
      Expand_Entities => False,
      Expand_Character_Ref => True,
      In_DTD => False,
      Recognize_External => False,
      Handle_Strings => True,
      In_Tag => True,
      Report_Parenthesis => False,
      In_Attlist => False);

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

   -- Internal subprograms --

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


   function Is_Name_Char (C : Unicode_Char) return Boolean;
   --  Return True if C is a valid character to use in a Name.


   procedure Test_Valid_Char
     (Parser : in out Reader'Class; C : Unicode_Char; Loc : Token);
   --  Raise an error if C is not valid in XML. The error is reported at

   --  location Loc.


   function Is_Pubid_Char (C : Unicode_Char) return Boolean;
   --  Return True if C is a valid character for a Public ID (2.3 specs)


   procedure Test_Valid_Lang
     (Parser : in out Reader'Class; Lang : Byte_Sequence);
   --  Return True if Lang matches the rules for languages


   Input_Ended : exception;

   procedure Next_Char
     (Input   : in out Input_Source'Class;
      Parser  : in out Reader'Class);
   --  Return the next character, and increments the locators

   --  Input_Ended is raised at the end


   procedure Put_In_Buffer
     (Parser : in out Reader'Class; Char : Unicode_Char);
   procedure Put_In_Buffer
     (Parser : in out Reader'Class; Str : Byte_Sequence);
   pragma Inline (Put_In_Buffer);
   --  Put the last character read in the internal buffer


   procedure Next_Token
     (Input  : in out Input_Sources.Input_Source'Class;
      Parser : in out Reader'Class;
      Id     : out Token);
   --  Return the next identifier in the input stream.

   --  Locator is modified accordingly (line and column)


   procedure Next_Token_Skip_Spaces
     (Input  : in out Input_Sources.Input_Source'Class;
      Parser : in out Reader'Class;
      Id     : out Token;
      Must_Have : Boolean := False);
   pragma Inline (Next_Token_Skip_Spaces);
   --  Same as Next_Token, except it skips spaces. If Must_Have is True,

   --  then the first token read must be a space, or an error is raised


   procedure Reset_Buffer
     (Parser : in out Reader'Class; Id : Token := Null_Token);
   --  Clears the internal buffer in Parser.

   --  If Id is not Null_Token, then only the characters starting from

   --  Id.First are removed


   function Value (Parser : Reader'Class; From, To : Token)
      return Unicode.CES.Byte_Sequence;
   --  Return the text that starts at the beginning of From, and ends at

   --  the end of To.


   procedure Set_State (Parser : in out Reader'Class; State : Parser_State);
   --  Set the current state for the parser


   function Get_State (Parser : Reader'Class) return Parser_State;
   --  Return the current state.


   procedure Syntactic_Parse
     (Parser : in out Reader'Class;
      Input  : in out Input_Sources.Input_Source'Class);
   --  Internal syntactical parser.


   procedure Find_NS
     (Parser  : in out Reader'Class;
      Elem    : Element_Access;
      Prefix  : Token;
      NS      : out XML_NS);
   --  Search the namespace associated with a given prefix in the scope of

   --  Elem or its parents. Use the empty string to get the default namespace.

   --  Fatal_Error is raised if no such namespace was found (and null is

   --  returned, in case Fatal_Error didn't raise an exception)


   function Qname_From_Name (Parser : Reader'Class; Prefix, Local_Name : Token)
      return Byte_Sequence;
   --  Create the qualified name from the namespace URI and the local name.


   procedure Add_Namespace
     (Parser : in out Reader'Class;
      Node   : Element_Access;
      Prefix, URI_Start, URI_End : Token;
      Report_Event : Boolean := True);
   --  Create a new prefix mapping (an XML namespace). If Node is null, then

   --  the mapping is added as a default namespace


   procedure Add_Namespace_No_Event
     (Parser : in out Reader'Class;
      Prefix : Byte_Sequence;
      Str    : Byte_Sequence);
   --  Create a new default namespace in the parser


   procedure Free (NS : in out XML_NS);
   --  Free NS and its successors in the list


   procedure Free (Parser : in out Reader'Class);
   --  Free the memory allocated for the parser, including the namespaces,

   --  entities,...


   procedure Free (Elem : in out Element_Access);
   --  Free the memory of Elem (and its contents). Note that this doesn't free

   --  the parent of Elem).

   --  On Exit, Elem is set to its parent.


   procedure Parse_Element_Model
     (Input   : in out Input_Sources.Input_Source'Class;
      Parser  : in out Reader'Class;
      Result  : out Element_Model_Ptr;
      Nmtokens : Boolean := False;
      Attlist : Boolean := False;
      Open_Was_Read : Boolean);
   --  Parse the following characters in the stream so as to create an

   --  element or attribute contents model, ie the tree matching an

   --  expression like "(foo|bar)+".

   --  Nmtokens should be true if the names in the model should follow the

   --  Nmtoken rule in XML specifications rather than the Name rule.

   --  If Open_Was_Read, then the opening parenthesis is considered to have

   --  been read already and is automatically inserted into the stack.

   --  Attlist should be set to true if this is the model in <!ELEMENT>


   procedure Parse_Element_Model_From_Entity
     (Parser : in out Reader'Class;
      Name   : Byte_Sequence;
      M      : out Element_Model_Ptr;
      Attlist : Boolean := False);
   --  Same as above, but the model is contained in the entity Name.


   procedure Fatal_Error
     (Parser : in out Reader'Class;
      Msg    : String;
      Id     : Token := Null_Token);
   --  Raises a fatal error.

   --  The error is reported at location Id (or the current parser location

   --  if Id is Null_Token).

   --  The user application should not return from this call. Thus, a

   --  Program_Error is raised if it does return.


   procedure Error
     (Parser : in out Reader'Class;
      Msg    : String;
      Id     : Token := Null_Token);
   --  Same as Fatal_Error, but reports an error instead


   function Location (Parser : Reader'Class; Id : Token) return Byte_Sequence;
   --  Return the location of the start of Id as a string.


   function Resolve_URI (Parser : Reader'Class; URI : Byte_Sequence)
      return Byte_Sequence;
   --  Return a fully resolved URI, based on the system identifier set for

   --  Machine, and URI.


   function Input_Id (Parser : Reader'Class) return Natural;
   pragma Inline (Input_Id);
   --  Return the current input id.


   procedure Close_Inputs (Parser : in out Reader'Class);
   --  Close the inputs that have been completely read. This should be

   --  called every time one starts an entity, so that calls to

   --  Start_Entity/End_Entity are properly nested, and error messages

   --  point to the right entity.


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

   -- Input_Id --

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


   function Input_Id (Parser : Reader'Class) return Natural is
   begin
      if Parser.Inputs = null then
         return 0;
      else
         return Parser.Inputs.Id;
      end if;
   end Input_Id;

   ----------

   -- Free --

   ----------


   procedure Free (Elem : in out Element_Access) is
      procedure Free_Element is new Unchecked_Deallocation
        (Element, Element_Access);
      Tmp : constant Element_Access := Elem.Parent;
   begin
      Free (Elem.NS);
      Free (Elem.Name);
      Free (Elem.Namespaces);
      Free_Element (Elem);
      Elem := Tmp;
   end Free;

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

   -- Resolve_URI --

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


   function Resolve_URI (Parser : Reader'Class; URI : Byte_Sequence)
      return Byte_Sequence
   is
      C : Unicode_Char;
      System_Id : constant Byte_Sequence := Get_System_Id (Parser.Locator.all);
      Index : Natural := System_Id'First;
      Basename_Start : Natural := System_Id'First;
   begin
      pragma Assert (URI /= "");
      --  ??? Only resolve paths for now

      if Encoding.Read (URI, URI'First) /= Slash then
         while Index <= System_Id'Last loop
            C := Encoding.Read (System_Id, Index);
            Index := Index + Encoding.Width (C);
            if C = Slash then
               Basename_Start := Index;
            end if;
         end loop;
      end if;
      return System_Id (System_Id'First .. Basename_Start - 1) & URI;
   end Resolve_URI;

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

   -- Location --

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


   function Location (Parser : Reader'Class; Id : Token)
      return Byte_Sequence
   is
      Line : constant Byte_Sequence := Natural'Image (Id.Line);
      Col : constant Byte_Sequence := Natural'Image (Id.Column);
   begin
      if Parser.Close_Inputs = null then
         return Get_Public_Id (Parser.Locator.all) & ':'
           & Line (Line'First + 1 .. Line'Last)
           & ':' & Col (Col'First + 1 .. Col'Last);
      else
         return Get_Public_Id (Parser.Close_Inputs.Input.all) & ':'
           & Line (Line'First + 1 .. Line'Last)
           & ':' & Col (Col'First + 1 .. Col'Last);
      end if;
   end Location;

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

   -- Fatal_Error --

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


   procedure Fatal_Error
     (Parser  : in out Reader'Class;
      Msg     : String;
      Id      : Token := Null_Token)
   is
      Id2 : Token := Id;
   begin
      if Id = Null_Token then
         Id2.Line   := Get_Line_Number (Parser.Locator.all);
         Id2.Column := Get_Column_Number (Parser.Locator.all) - 1;
      end if;
      Parser.Buffer_Length := 0;
      Fatal_Error
        (Parser, Create (Location (Parser, Id2) & ": " & Msg,
                         Parser.Locator));
      raise Program_Error;
   end Fatal_Error;

   -----------

   -- Error --

   -----------


   procedure Error
     (Parser  : in out Reader'Class;
      Msg     : String;
      Id      : Token := Null_Token)
   is
      Id2 : Token := Id;
   begin
      if Id = Null_Token then
         Id2.Line := Get_Line_Number (Parser.Locator.all);
         Id2.Column := Get_Column_Number (Parser.Locator.all);
      end if;
      Error (Parser, Create (Location (Parser, Id2) & ": " & Msg,
                             Parser.Locator));
   end Error;

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

   -- Next_Char --

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


   procedure Next_Char
     (Input   : in out Input_Source'Class;
      Parser  : in out Reader'Class)
   is
      procedure Internal (Stream : in out Input_Source'Class);

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

      -- Internal --

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


      procedure Internal (Stream : in out Input_Source'Class) is
         C : Unicode_Char;
      begin
         Next_Char (Stream, C);
         if C = Line_Feed then
            Set_Column_Number (Parser.Locator.all, 1);
            Set_Line_Number
              (Parser.Locator.all, Get_Line_Number (Parser.Locator.all) + 1);
         else
            Set_Column_Number
              (Parser.Locator.all, Get_Column_Number (Parser.Locator.all) + 1);
         end if;

         --  XML specs say that #xD#xA must be converted to one single #xA.

         --  A single #xD must be converted to one single #xA


         if C = Carriage_Return then
            Parser.Previous_Char_Was_CR := True;
            Parser.Last_Read := Line_Feed;

         elsif C = Line_Feed and then Parser.Previous_Char_Was_CR then
            Parser.Previous_Char_Was_CR := False;
            Next_Char (Input, Parser);
         else
            Parser.Previous_Char_Was_CR := False;
            Parser.Last_Read := C;
            Test_Valid_Char (Parser, Parser.Last_Read, Null_Token);
         end if;
      end Internal;

      Input_A : Entity_Input_Source_Access;
   begin
      while Parser.Inputs /= null and then Eof (Parser.Inputs.Input.all) loop
         Copy (Parser.Locator.all, Parser.Inputs.Save_Loc);
         Free (Parser.Inputs.Save_Loc);

         if Parser.Inputs.External then
            Parser.In_External_Entity := False;
            --  ??? Should test whether we are still in an external entity.

            --  However, this is only used for the <?xml?> PI, and at this

            --  point we have already read and discarded it, so it doesn't

            --  really matter.

         end if;

         --  Insert the closed input at the end of the Close_Input list, so

         --  that the next call to Next_Token properly closes the entity.

         --  This can not be done here, otherwise End_Entity is called too

         --  early, and the error messages do not point to the right entity.

         if Parser.Close_Inputs = null then
            Parser.Close_Inputs := Parser.Inputs;
         else
            Input_A := Parser.Close_Inputs;
            while Input_A.Next /= null loop
               Input_A := Input_A.Next;
            end loop;
            Input_A.Next := Parser.Inputs;
         end if;

         Input_A := Parser.Inputs;
         Parser.Inputs := Parser.Inputs.Next;
         Input_A.Next := null;
      end loop;

      --  Read the text of the entity if there is any


      if Parser.Inputs /= null then
         Internal (Parser.Inputs.Input.all);

      --  Else read from the initial input stream

      elsif Eof (Input) then
         if Debug_Input then
            Put_Line
              ("++Input " & To_String (Parser.Locator.all) & " END_OF_INPUT");
         end if;
         Parser.Last_Read := 16#FFFF#;
         raise Input_Ended;

      else
         Internal (Input);
      end if;

      if Debug_Input then
         Put ("++Input " & To_String (Parser.Locator.all)
              & "(" & Unicode_Char'Image (Parser.Last_Read) & ")= ");
         if Parser.Last_Read /= Line_Feed then
            Put_Line (Encoding.Encode (Parser.Last_Read));
         else
            Put_Line ("Line_Feed");
         end if;
      end if;
   end Next_Char;

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

   -- Put_In_Buffer --

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


   procedure Put_In_Buffer
     (Parser : in out Reader'Class; Char : Unicode_Char) is
   begin
      Put_In_Buffer (Parser, Encoding.Encode (Char));
   end Put_In_Buffer;

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

   -- Put_In_Buffer --

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


   procedure Put_In_Buffer
     (Parser : in out Reader'Class; Str : Byte_Sequence) is
   begin
      pragma Assert (Parser.Buffer_Length + Str'Length <= Parser.Buffer'Last);
      Parser.Buffer
        (Parser.Buffer_Length + 1 .. Parser.Buffer_Length + Str'Length) := Str;
      Parser.Buffer_Length := Parser.Buffer_Length + Str'Length;
   end Put_In_Buffer;

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

   -- Is_Name_Char --

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


   function Is_Name_Char (C : Unicode_Char) return Boolean is
   begin
      return C = Period
        or else C = Hyphen_Minus
        or else C = Spacing_Underscore
        or else Is_Digit (C)
        or else Is_Letter (C)
        or else Is_Combining_Char (C)
        or else Is_Extender (C);
   end Is_Name_Char;

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

   -- Test_Valid_Lang --

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


   procedure Test_Valid_Lang
     (Parser : in out Reader'Class; Lang : Byte_Sequence)
   is
      C, C2 : Unicode_Char;
      Index : Natural := Lang'First;
   begin
      C2 := Encoding.Read (Lang, Index);
      Index := Index + Encoding.Width (C2);

      if not (C2 in Latin_Small_Letter_A .. Latin_Small_Letter_Z
              or else C2 in Latin_Capital_Letter_A .. Latin_Capital_Letter_Z)
        or else Index > Lang'Last
      then
         Fatal_Error (Parser, "[2.12] Invalid language specification");
      end if;

      C := Encoding.Read (Lang, Index);
      Index := Index + Encoding.Width (C);
      if C in Latin_Small_Letter_A .. Latin_Small_Letter_Z
        or else C in Latin_Capital_Letter_A .. Latin_Capital_Letter_Z
      then
         if Index <= Lang'Last then
            C := Encoding.Read (Lang, Index);
            Index := Index + Encoding.Width (C);
         end if;

      elsif C2 /= Latin_Small_Letter_I
        and then C2 /= Latin_Capital_Letter_I
        and then C2 /= Latin_Small_Letter_X
        and then C2 /= Latin_Capital_Letter_X
      then
         Fatal_Error (Parser, "[2.12] Invalid language specification");
      end if;

      if C = Hyphen_Minus and then Index > Lang'Last then
         Fatal_Error (Parser, "[2.12] Invalid language specification");
      end if;

      while Index <= Lang'Last loop
         if C /= Hyphen_Minus
           or else Index > Lang'Last
         then
            Fatal_Error (Parser, "[2.12] Invalid language specification");
         end if;

         loop
            C := Encoding.Read (Lang, Index);
            Index := Index + Encoding.Width (C);

            exit when Index > Lang'Last
              or else not
              (C in Latin_Small_Letter_A .. Latin_Small_Letter_Z
               or else C in Latin_Capital_Letter_A .. Latin_Capital_Letter_Z);
         end loop;
      end loop;
   end Test_Valid_Lang;

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

   -- Is_Pubid_Char --

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


   function Is_Pubid_Char (C : Unicode_Char) return Boolean is
   begin
      return C = Unicode.Names.Basic_Latin.Space
        or else C = Line_Feed
        or else C in Latin_Small_Letter_A .. Latin_Small_Letter_Z
        or else C in Latin_Capital_Letter_A .. Latin_Capital_Letter_Z
        or else C in Digit_Zero .. Digit_Nine
        or else C = Hyphen_Minus
        or else C = Apostrophe
        or else C = Opening_Parenthesis
        or else C = Closing_Parenthesis
        or else C = Plus_Sign
        or else C = Comma
        or else C = Dot
        or else C = Slash
        or else C = Unicode.Names.Basic_Latin.Colon
        or else C = Equals_Sign
        or else C = Question_Mark
        or else C = Semicolon
        or else C = Exclamation_Mark
        or else C = Star
        or else C = Number_Sign
        or else C = Commercial_At
        or else C = Dollar_Sign
        or else C = Spacing_Underscore
        or else C = Percent_Sign;
   end Is_Pubid_Char;

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

   -- Test_Valid_Char --

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


   procedure Test_Valid_Char
     (Parser : in out Reader'Class; C : Unicode_Char; Loc : Token)
   is
      Id : Token;
   begin
      if not (C = 16#9#
              or else C = 16#A#
              or else C = 16#D#
              or else C in Unicode.Names.Basic_Latin.Space .. 16#D7FF#
              or else C in 16#E000# .. 16#FFFD#
              or else C in 16#10000# .. 16#10FFFF#)
      then
         if Loc /= Null_Token then
            Id := Loc;
         else
            Id.Line := Get_Line_Number (Parser.Locator.all);
            Id.Column := Get_Column_Number (Parser.Locator.all) - 1;
         end if;
         Fatal_Error
           (Parser, "[2.2] Invalid character (code"
            & Unicode_Char'Image (C) & ")", Id);
      end if;
   end Test_Valid_Char;

   ----------

   -- Free --

   ----------


   procedure Free (NS : in out XML_NS) is
      Tmp : XML_NS;
      procedure Free_NS is new Unchecked_Deallocation (XML_NS_Record, XML_NS);
   begin
      while NS /= null loop
         Tmp := NS.Next;
         Free (NS.Prefix);
         Free (NS.URI);
         Free_NS (NS);
         NS := Tmp;
      end loop;
   end Free;

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

   -- Find_NS --

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


   procedure Find_NS
     (Parser  : in out Reader'Class;
      Elem    : Element_Access;
      Prefix  : Token;
      NS      : out XML_NS)
   is
      Name : constant Byte_Sequence := Value (Parser, Prefix, Prefix);
      E : Element_Access := Elem;
   begin
      loop
         --  Search in the default namespaces

         if E = null then
            NS := Parser.Default_Namespaces;
         else
            NS := E.Namespaces;
         end if;

         while NS /= null loop
            if NS.Prefix.all = Name then
               return;
            end if;
            NS := NS.Next;
         end loop;

         exit when E = null;
         E := E.Parent;
      end loop;

      Fatal_Error
        (Parser, "[WF] Prefix '" & Name & "' must be declared before its use");
      NS := null;
   end Find_NS;

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

   -- Qname_From_Name --

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


   function Qname_From_Name (Parser : Reader'Class; Prefix, Local_Name : Token)
      return Byte_Sequence is
   begin
      if Prefix = Null_Token then
         return Value (Parser, Local_Name, Local_Name);
      else
         return Value (Parser, Prefix, Prefix)
           & Encoding.Encode (Unicode.Names.Basic_Latin.Colon)
           & Value (Parser, Local_Name, Local_Name);
      end if;
   end Qname_From_Name;

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

   -- Add_Namespace_No_Event --

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


   procedure Add_Namespace_No_Event
     (Parser : in out Reader'Class;
      Prefix : Byte_Sequence;
      Str    : Byte_Sequence)
   is
      Pref, URI : Token;
   begin
      Pref.First := Parser.Buffer_Length + 1;
      Put_In_Buffer (Parser, Prefix);
      Pref.Last := Parser.Buffer_Length;
      URI.First := Parser.Buffer_Length + 1;
      Put_In_Buffer (Parser, Str);
      URI.Last := Parser.Buffer_Length;
      Add_Namespace (Parser, null, Pref, URI, URI, Report_Event => False);
      Reset_Buffer (Parser, Pref);
   end Add_Namespace_No_Event;

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

   -- Add_Namespace --

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


   procedure Add_Namespace
     (Parser : in out Reader'Class;
      Node   : Element_Access;
      Prefix, URI_Start, URI_End : Token;
      Report_Event : Boolean := True)
   is
      NS : XML_NS;
   begin
      NS := new XML_NS_Record'
        (Prefix => new Byte_Sequence' (Value (Parser, Prefix, Prefix)),
         URI    => new Byte_Sequence' (Value (Parser, URI_Start, URI_End)),
         Next   => null);

      if Node = null then
         NS.Next := Parser.Default_Namespaces;
         Parser.Default_Namespaces := NS;
      else
         NS.Next := Node.Namespaces;
         Node.Namespaces := NS;
      end if;

      --  Report the event, except for the default namespace

      if Report_Event then
         Start_Prefix_Mapping
           (Parser,
            Prefix => NS.Prefix.all,
            URI    => NS.URI.all);
      end if;
   end Add_Namespace;

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

   -- Close_Inputs --

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


   procedure Close_Inputs (Parser : in out Reader'Class) is
      procedure Free is new Unchecked_Deallocation
        (Entity_Input_Source, Entity_Input_Source_Access);
      procedure Unchecked_Free is new Unchecked_Deallocation
        (Input_Source'Class, Input_Source_Access);
      Input_A : Entity_Input_Source_Access;
   begin
      while Parser.Close_Inputs /= null loop
         Close (Parser.Close_Inputs.Input.all);
         Unchecked_Free (Parser.Close_Inputs.Input);

         --  not in string context

         if not Parser.State.Ignore_Special then
            End_Entity (Parser, Parser.Close_Inputs.Name.all);
         end if;

         Input_A := Parser.Close_Inputs;
         Parser.Close_Inputs := Parser.Close_Inputs.Next;
         Free (Input_A.Name);
         Free (Input_A);
      end loop;
   end Close_Inputs;

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

   -- Next_Token --

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


   procedure Next_Token
     (Input   : in out Input_Source'Class;
      Parser  : in out Reader'Class;
      Id      : out Token)
   is
      function Looking_At (Str : Byte_Sequence) return Boolean;
      --  True if the next characters read (including the current one) in the

      --  stream match Str. Characters read are stored in the buffer


      procedure Handle_Comments;
      --  <!- has been seen in the buffer, check if this is a comment and

      --  handle it appropriately


      procedure Handle_Character_Ref;
      --  '&#' has been seen in the buffer, check if this is a character

      --  entity reference and handle it appropriately


      procedure Handle_Less_Than_Sign;
      --  Handle '<', '<!', '<!--', '<![',... sequences


      procedure Debug_Print;
      --  Print the returned token


      procedure Handle_Entity_Ref;
      --  '&' has been read (as well as the following character). Skips till

      --  the end of the entity, ie ';'. Saves the name of the entity in the

      --  buffer.

      --  Parser.Last_Read is left to ';', but it is not put in the buffer.


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

      -- Looking_At --

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


      function Looking_At (Str : Byte_Sequence) return Boolean is
         C : Unicode_Char;
         Index : Natural := Str'First;
      begin
         while Index <= Str'Last loop
            C := Encoding.Read (Str, Index);
            Index := Index + Encoding.Width (C);

            if C /= Parser.Last_Read or else Eof (Input) then
               return False;
            end if;
            Put_In_Buffer (Parser, Parser.Last_Read);
            Next_Char (Input, Parser);
         end loop;
         return True;
      end Looking_At;

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

      -- Handle_Comments --

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


      procedure Handle_Comments is
      begin
         if not Eof (Input) then
            Next_Char (Input, Parser);
            if Parser.Last_Read = Hyphen_Minus then
               Id.Typ := Comment;  --  In case we reach the eof in the loop

               --  Note that if the file ends exactly with '<!--', we get

               --  an empty text. But at least we will detect the error.

               --  It also fails if we have a non-terminated comment and the

               --  last character in the file is '-'. Doesn't seem worth

               --  paying the cost for some extra tests to handle this.

               loop
                  Next_Char (Input, Parser);
                  if Parser.Last_Read = Hyphen_Minus then
                     Next_Char (Input, Parser);
                     if Parser.Last_Read = Hyphen_Minus then
                        if not Eof (Input) then
                           Next_Char (Input, Parser);
                           if Parser.Last_Read = Greater_Than_Sign then
                              exit;
                           end if;
                        end if;
                        Parser.Buffer_Length := Id.First - 1;
                        Id.Line := Get_Line_Number (Parser.Locator.all);
                        Id.Column :=
                          Get_Column_Number (Parser.Locator.all) - 3;
                        --  3 = 2 * Hyphen_Minus + Parser.Last_Read

                        Fatal_Error
                          (Parser, "[2.5] '--' cannot appear in comments", Id);

                     else
                        Put_In_Buffer (Parser, Hyphen_Minus);
                        Put_In_Buffer (Parser, Parser.Last_Read);
                     end if;
                  else
                     Put_In_Buffer (Parser, Parser.Last_Read);
                  end if;
               end loop;

               if Input_Id (Parser) /= Id.Input_Id then
                  Fatal_Error
                    (Parser, "[4.5] Entity values must be self-contained", Id);
               end if;

               if not Eof (Input) then
                  Next_Char (Input, Parser);
               end if;
               return;
            end if;
         end if;
         Fatal_Error (Parser, "[WF] Invalid characters '<!-' in stream");
         Id.Typ := End_Of_Input;
      end Handle_Comments;

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

      -- Handle_Character_Ref --

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


      procedure Handle_Character_Ref is
         Val : Unicode_Char := 0;
      begin
         Id.Typ := Text;

         if Parser.Current_Node = null
           and then Parser.State.Name = Default_State.Name
         then
            Fatal_Error
              (Parser,
               "[2.1] Character references can not appear at top-level",  Id);
         end if;

         Next_Char (Input, Parser);
         if Parser.Last_Read = Latin_Small_Letter_X then
            Next_Char (Input, Parser);

            while Parser.Last_Read /= Semicolon loop
               if Parser.Last_Read in Digit_Zero .. Digit_Nine then
                  Val := Val * 16 + Parser.Last_Read - Digit_Zero;

               elsif Parser.Last_Read in
                 Latin_Capital_Letter_A .. Latin_Capital_Letter_F
               then
                  Val := Val * 16 + Parser.Last_Read - Latin_Capital_Letter_A
                    + 10;

               elsif Parser.Last_Read in
                 Latin_Small_Letter_A .. Latin_Small_Letter_F
               then
                  Val := Val * 16 + Parser.Last_Read - Latin_Small_Letter_A
                    + 10;

               else
                  Id.Line := Get_Line_Number (Parser.Locator.all);
                  Id.Column := Get_Column_Number (Parser.Locator.all) - 1;
                  Fatal_Error
                    (Parser, "[4.1] Invalid character '"
                     & Encoding.Encode (Parser.Last_Read) & "' in"
                     & " character reference", Id);
               end if;
               Next_Char (Input, Parser);
            end loop;
         else
            while Parser.Last_Read /= Semicolon loop
               if Parser.Last_Read in Digit_Zero .. Digit_Nine then
                  Val := Val * 10 + Parser.Last_Read - Digit_Zero;
               else
                  Id.Line := Get_Line_Number (Parser.Locator.all);
                  Id.Column := Get_Column_Number (Parser.Locator.all) - 1;
                  Fatal_Error
                    (Parser, "[4.1] Invalid character '"
                     & Encoding.Encode (Parser.Last_Read) & "' in"
                     & " character reference", Id);
               end if;
               Next_Char (Input, Parser);
            end loop;
         end if;

         Test_Valid_Char (Parser, Val, Id);
         Put_In_Buffer (Parser, Val);
         Next_Char (Input, Parser);
      end Handle_Character_Ref;

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

      -- Handle_Less_Than_Sign --

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


      procedure Handle_Less_Than_Sign is
         Num_Closing_Bracket : Natural;
         Id2 : Token;
      begin
         Id.Typ := Start_Of_Tag;
         Next_Char (Input, Parser);
         case Parser.Last_Read is
            when Slash =>
               Id.Typ := Start_Of_End_Tag;
               Next_Char (Input, Parser);

            when Exclamation_Mark =>
               Next_Char (Input, Parser);
               if Parser.Last_Read = Hyphen_Minus then
                  Handle_Comments;

               elsif Looking_At (Doctype_Sequence) then
                  Reset_Buffer (Parser, Id);
                  Id.Typ := Doctype_Start;

               elsif Parser.Last_Read = Opening_Square_Bracket then
                  Next_Char (Input, Parser);

                  if Parser.Last_Read = Latin_Capital_Letter_C then

                     if not Looking_At (Cdata_Sequence) then
                        Fatal_Error (Parser, "Invalid declaration", Id);
                     end if;

                     if Parser.Last_Read /= Opening_Square_Bracket then
                        Fatal_Error
                          (Parser,
                           "CDATA must be followed immediately by '['", Id);
                     end if;

                     Reset_Buffer (Parser, Id);
                     Id.Typ := Cdata_Section;
                     Num_Closing_Bracket := 1;
                     loop
                        Next_Char (Input, Parser);
                        Put_In_Buffer (Parser, Parser.Last_Read);

                        if Parser.Last_Read = Closing_Square_Bracket then
                           Num_Closing_Bracket := Num_Closing_Bracket + 1;

                        elsif Parser.Last_Read = Greater_Than_Sign
                          and then Num_Closing_Bracket >= 2
                        then
                           Parser.Buffer_Length := Parser.Buffer_Length
                             - 2 * Encoding.Width (Closing_Square_Bracket)
                             - Encoding.Width (Greater_Than_Sign);
                           exit;

                        else
                           Num_Closing_Bracket := 0;
                        end if;
                     end loop;
                     if Id.Input_Id /= Input_Id (Parser) then
                        Fatal_Error
                          (Parser, "[4.3.2] Entity must be self-contained",
                           Id);
                     end if;

                     if not Eof (Input) then
                        Next_Char (Input, Parser);
                     else
                        Parser.Last_Read := 16#FFFF#;
                     end if;

                  else
                     while Is_White_Space (Parser.Last_Read) loop
                        Next_Char (Input, Parser);
                     end loop;

                     if Parser.Last_Read = Latin_Capital_Letter_I
                       or else Parser.Last_Read = Percent_Sign
                     then
                        Next_Token (Input, Parser, Id2);
                        if Value (Parser, Id2, Id2) = Include_Sequence then
                           Reset_Buffer (Parser, Id2);
                           Id.Typ := Include;
                        elsif Value (Parser, Id2, Id2)  = Ignore_Sequence then
                           Reset_Buffer (Parser, Id2);
                           Id.Typ := Ignore;
                        else
                           Fatal_Error (Parser, "Invalid declaration", Id);
                        end if;

                        if not Parser.State.In_DTD
                          or else not Parser.In_External_Entity
                        then
                           Fatal_Error
                             (Parser, "[3.4] INCLUDE and IGNORE sections only"
                              & " authorized in the external DTD subset", Id);
                        end if;

                        Next_Token_Skip_Spaces (Input, Parser, Id2);
                        if Id2.Typ /= Internal_DTD_Start then
                           Fatal_Error
                             (Parser,
                              "(3.4) Conditional sections need a '[' after the"
                              & " INCLUDE or IGNORE", Id2);
                        end if;

                     elsif Parser.State.In_DTD then
                        Id.Typ := Start_Conditional;
                     else
                        Fatal_Error
                          (Parser,
                           "No declaration starting with '<!' outside of DTD",
                           Id);
                     end if;
                  end if;

               elsif not Parser.State.In_DTD then
                  Fatal_Error
                    (Parser,
                     "No declaration starting with '<!' outside of DTD", Id);
                  Id.Typ := End_Of_Input;

               elsif Looking_At (Attlist_Sequence) then
                  Reset_Buffer (Parser, Id);
                  Id.Typ := Attlist_Def;

               elsif Parser.Last_Read = Latin_Capital_Letter_E then
                  Next_Char (Input, Parser);
                  if Looking_At (Ntity_Sequence) then
                     Reset_Buffer (Parser, Id);
                     Id.Typ := Entity_Def;

                  elsif Looking_At (Element_Sequence) then
                     Reset_Buffer (Parser, Id);
                     Id.Typ := Element_Def;

                  else
                     Fatal_Error (Parser, "[WF] Unknown declaration in DTD");
                  end if;

               elsif Looking_At (Notation_Sequence) then
                  Reset_Buffer (Parser, Id);
                  Id.Typ := Notation;

               else
                  Put_In_Buffer (Parser, Less_Than_Sign);
                  Put_In_Buffer (Parser, Exclamation_Mark);
                  Id.Typ := Text;
               end if;

            when Question_Mark =>
               Id.Typ := Start_Of_PI;
               Next_Char (Input, Parser);

            when others => null;
         end case;
      end Handle_Less_Than_Sign;

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

      -- Handle_Entity_Ref --

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


      procedure Handle_Entity_Ref is
      begin
         if Is_Letter (Parser.Last_Read)
           or else Parser.Last_Read = Spacing_Underscore
         then
            while Parser.Last_Read /= Semicolon
              and then Is_Name_Char (Parser.Last_Read)
            loop
               Put_In_Buffer (Parser, Parser.Last_Read);
               Next_Char (Input, Parser);
            end loop;

            if Parser.Last_Read /= Semicolon then
               Fatal_Error
                 (Parser, "[4.1] Entity references must end with ';'."
                  & ASCII.LF & "Did you want to use &amp; ?", Id);
            end if;

            if Input_Id (Parser) /= Id.Input_Id then
               Fatal_Error
                 (Parser, "[4.3.2] Entity must be self-contained", Id);
            end if;

         else
            Fatal_Error
              (Parser, "[4.1] Invalid first letter in entity name '"
               & Encoding.Encode (Parser.Last_Read) & "'", Id);
         end if;
      end Handle_Entity_Ref;

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

      -- Debug_Print --

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


      procedure Debug_Print is
         L : Locator_Impl := Locator_Impl (Parser.Locator.all);
      begin
         Set_Line_Number (L, Id.Line);
         Set_Column_Number (L, Id.Column);
         Put ("++Lex (" & Parser.State.Name & ") at "
              & To_String (L) & " (" & Id.Typ'Img & ")");
         if Parser.State.Ignore_Special then
            Put (" (in string)");
         end if;

         if Id.Typ = Space then
            declare
               J : Natural := Id.First;
               C : Unicode_Char;
            begin
               Put (" --");

               while J <= Id.Last loop
                  C := Encoding.Read (Parser.Buffer, J);
                  J := J + Encoding.Width (C);
                  Put (Unicode_Char'Image (C));
               end loop;
               Put ("--");

            end;

         elsif Id.Last >= Id.First then
            Put (" --" & Parser.Buffer (Id.First .. Id.Last) & "--");

         end if;

         Put_Line
           (" buffer="
            & Parser.Buffer (Parser.Buffer'First .. Parser.Buffer_Length)
            & "--");

      end Debug_Print;

      type Entity_Ref is (None, Entity, Param_Entity);
      Is_Entity_Ref : Entity_Ref := None;
   begin
      Id.First := Parser.Buffer_Length + 1;
      Id.Last := Parser.Buffer_Length;
      Id.Typ := End_Of_Input;
      Id.Line := Get_Line_Number (Parser.Locator.all);
      Id.Column := Get_Column_Number (Parser.Locator.all) - 1;
      Id.Input_Id := Input_Id (Parser);
      Close_Inputs (Parser);

      if Eof (Input) and then Parser.Last_Read = 16#FFFF# then
         Id.Column := Id.Column + 1;
         return;
      end if;

      if Is_White_Space (Parser.Last_Read) then
         Id.Typ := Space;
         loop
            Put_In_Buffer (Parser, Parser.Last_Read);
            Next_Char (Input, Parser);
            exit when not Is_White_Space (Parser.Last_Read);
         end loop;

      --  If we are ignoring special characters

      elsif Id.Typ = End_Of_Input
        and then not Parser.Ignore_State_Special
        and then Parser.State.Ignore_Special
        and then not Parser.State.Detect_End_Of_PI
      then
         Id.Typ := Text;
         Parser.Ignore_State_Special := True;
         loop
            exit when Parser.Last_Read = Ampersand
              and then (Parser.State.Expand_Entities
                        or else Parser.State.Expand_Character_Ref);
            exit when Parser.Last_Read = Percent_Sign
              and then Parser.State.Expand_Param_Entities;
            exit when (Parser.Last_Read = Apostrophe
                       or else Parser.Last_Read = Quotation_Mark)
              and then Parser.State.Handle_Strings
              and then (Parser.Inputs = null
                        or else Parser.Inputs.Handle_Strings);
            exit when Parser.Last_Read = Less_Than_Sign
              and then Parser.State.Less_Special;
            Put_In_Buffer (Parser, Parser.Last_Read);
            Next_Char (Input, Parser);
         end loop;
      end if;

      --  If we haven't found a non-empty token yet

      if Id.Typ = End_Of_Input
        or else Id.First > Parser.Buffer_Length
      then
         case Parser.Last_Read is
            when Less_Than_Sign =>
               if Parser.State.Less_Special then
                  Id.Typ := Start_Of_Tag;
                  Next_Char (Input, Parser);
               elsif Parser.State.Detect_End_Of_PI then
                  Put_In_Buffer (Parser, Parser.Last_Read);
                  Id.Typ := Text;
                  Next_Char (Input, Parser);
               else
                  Handle_Less_Than_Sign;
               end if;

            when Question_Mark =>
               if Eof (Input) then
                  Put_In_Buffer (Parser, Parser.Last_Read);
                  Id.Typ := Text;
               else
                  Next_Char (Input, Parser);
                  if Parser.Last_Read = Greater_Than_Sign then
                     Id.Typ := End_Of_PI;
                     Next_Char (Input, Parser);
                  elsif Parser.Last_Read = Question_Mark then
                     Put_In_Buffer (Parser, Question_Mark);
                     Id.Typ := Text;
                  else
                     Put_In_Buffer (Parser, Question_Mark);
                     Id.Typ := Text;
                  end if;
               end if;

            when Greater_Than_Sign =>
               if Parser.State.Greater_Special then
                  Id.Typ := End_Of_Tag;
               else
                  Put_In_Buffer (Parser, Parser.Last_Read);
                  Id.Typ := Text;
               end if;
               Next_Char (Input, Parser);

            when Equals_Sign =>
               if Parser.State.In_Tag then
                  Id.Typ := Equal;
               else
                  Put_In_Buffer (Parser, Parser.Last_Read);
                  Id.Typ := Text;
               end if;
               Next_Char (Input, Parser);

            when Unicode.Names.Basic_Latin.Colon =>
               if Parser.State.In_Tag then
                  Id.Typ := Colon;
               else
                  Put_In_Buffer (Parser, Parser.Last_Read);
                  Id.Typ := Text;
               end if;
               Next_Char (Input, Parser);

            when Ampersand =>
               Id.Typ := Text; --  So that eof would at least report an error

               if Eof (Input)
                 and then Parser.State.Expand_Entities
               then
                  Fatal_Error
                    (Parser, "[4.1] Entity references must end with ';'."
                     & ASCII.LF & "Did you want to use &amp; ?", Id);
               end if;

               Next_Char (Input, Parser);
               if Parser.Last_Read = Number_Sign
                 and then Parser.State.Expand_Character_Ref
               then
                  Handle_Character_Ref;
                  if Input_Id (Parser) /= Id.Input_Id then
                     Fatal_Error
                       (Parser, "[4.3.2] Entity must be self-contained",
                        Id);
                  end if;

               elsif Parser.Last_Read /= Number_Sign
                 and then Parser.State.Expand_Entities
               then
                  Handle_Entity_Ref;
                  Is_Entity_Ref := Entity;

               elsif Parser.Last_Read /= Number_Sign
                 and then Parser.State.Ignore_Special   --  string context

                 and then not Parser.State.Detect_End_Of_PI  --  not in PI

               then
                  --  Inside a string (entity value), we still need to check

                  --  that the '&' marks the beginning of an entity reference.

                  Put_In_Buffer (Parser, Ampersand);
                  Handle_Entity_Ref;
                  Put_In_Buffer (Parser, Parser.Last_Read);
                  Next_Char (Input, Parser);

               else
                  Put_In_Buffer (Parser, Ampersand);
               end if;

            when Percent_Sign =>
               Put_In_Buffer (Parser, Parser.Last_Read);
               Id.Typ := Text;

               Next_Char (Input, Parser);
               if Parser.State.Expand_Param_Entities then
                  while Parser.Last_Read /= Semicolon
                    and then Is_Name_Char (Parser.Last_Read)
                  loop
                     Put_In_Buffer (Parser, Parser.Last_Read);
                     Next_Char (Input, Parser);
                  end loop;

                  if Parser.Last_Read /= Semicolon then
                     Fatal_Error (Parser, "[WF] Unterminated entity");
                  end if;
                  Is_Entity_Ref := Param_Entity;
               end if;

            when Quotation_Mark =>
               if Parser.State.Handle_Strings then
                  Id.Typ := Double_String_Delimiter;
                  Next_Char (Input, Parser);
               else
                  Id.Typ := Text;
                  Put_In_Buffer (Parser, Parser.Last_Read);
                  Next_Char (Input, Parser);
               end if;

            when Apostrophe =>
               if Parser.State.Handle_Strings then
                  Id.Typ := Single_String_Delimiter;
                  Next_Char (Input, Parser);
               else
                  Id.Typ := Text;
                  Put_In_Buffer (Parser, Parser.Last_Read);
                  Next_Char (Input, Parser);
               end if;

            when Opening_Square_Bracket =>
               if Parser.State.In_DTD then
                  Id.Typ := Internal_DTD_Start;
               else
                  Put_In_Buffer (Parser, Parser.Last_Read);
                  Id.Typ := Text;
               end if;
               Next_Char (Input, Parser);

            when Closing_Square_Bracket =>
               if Parser.State.In_DTD
                 and then not Parser.In_External_Entity
               then
                  Id.Typ := Internal_DTD_End;
                  loop
                     Next_Char (Input, Parser);
                     exit when Parser.Last_Read = Greater_Than_Sign;
                     if not Is_White_Space (Parser.Last_Read) then
                        Fatal_Error
                          (Parser, "[2.8] Unexpected character between ']'"
                           & " and '>' in the DTD", Id);
                     end if;
                  end loop;
                  Next_Char (Input, Parser);

               --  In string context ?

               elsif Parser.State.Ignore_Special then
                  Id.Typ := Text;
                  Put_In_Buffer (Parser, Parser.Last_Read);
                  Next_Char (Input, Parser);

               else
                  declare
                     Num_Bracket : Natural := 1;
                  begin
                     Id.Typ := Text;

                     loop
                        Put_In_Buffer (Parser, Parser.Last_Read);
                        Next_Char (Input, Parser);

                        if Parser.Last_Read = Closing_Square_Bracket then
                           Num_Bracket := Num_Bracket + 1;

                        elsif Num_Bracket >= 2
                          and Parser.Last_Read = Greater_Than_Sign
                        then
                           if Parser.State.In_DTD
                             and then Parser.In_External_Entity
                           then
                              Id.Typ := End_Conditional;
                              Reset_Buffer (Parser, Id);
                              Next_Char (Input, Parser);
                              exit;
                           else
                              Id.Column := Id.Column + Num_Bracket - 2;
                              Fatal_Error
                                (Parser,
                                 "[2.4] Text may not contain the litteral"
                                 & " ']]>'", Id);
                           end if;
                        else
                           exit;
                        end if;
                     end loop;
                  end;
               end if;

            when Slash =>
               Id.Typ := Text;
               Next_Char (Input, Parser);
               if Parser.State.Greater_Special
                 and then Parser.Last_Read = Greater_Than_Sign
               then
                  Id.Typ := End_Of_Start_Tag;
                  Next_Char (Input, Parser);
               else
                  Put_In_Buffer (Parser, Slash);
               end if;

            when others =>
               if Parser.State.Recognize_External then

                  if Parser.Last_Read = Latin_Capital_Letter_A then
                     if Looking_At (Any_Sequence) then
                        Reset_Buffer (Parser, Id);
                        Id.Typ := Any;
                     else
                        Id.Typ := Name;
                     end if;

                  elsif Parser.Last_Read = Latin_Capital_Letter_E then
                     if Looking_At (Empty_Sequence) then
                        Reset_Buffer (Parser, Id);
                        Id.Typ := Empty;
                     else
                        Id.Typ := Name;
                     end if;

                  elsif Parser.Last_Read = Latin_Capital_Letter_N then
                     if Looking_At (Ndata_Sequence) then
                        Reset_Buffer (Parser, Id);
                        Id.Typ := Ndata;
                     else
                        Id.Typ := Name;
                     end if;

                  elsif Parser.Last_Read = Latin_Capital_Letter_P then
                     if Looking_At (Public_Sequence) then
                        Reset_Buffer (Parser, Id);
                        Id.Typ := Public;
                     else
                        Id.Typ := Name;
                     end if;

                  elsif Parser.Last_Read = Latin_Capital_Letter_S then
                     if Looking_At (System_Sequence) then
                        Reset_Buffer (Parser, Id);
                        Id.Typ := System;
                     else
                        Id.Typ := Name;
                     end if;
                  end if;
               end if;

               if Parser.State.Report_Parenthesis
                 and then Parser.Last_Read = Opening_Parenthesis
               then
                  Reset_Buffer (Parser, Id);
                  Id.Typ := Open_Paren;
                  Next_Char (Input, Parser);
               end if;

               if Parser.State.In_Attlist then
                  if Parser.Last_Read = Latin_Capital_Letter_C then
                     if Looking_At (Cdata_Sequence) then
                        Id.Typ := Cdata;
                     else
                        Id.Typ := Name;
                     end if;

                  elsif Parser.Last_Read = Latin_Capital_Letter_E
                    and then Looking_At (Entit_Sequence)
                  then
                     if Looking_At (Ies_Sequence) then
                        Id.Typ := Entities;
                     elsif Parser.Last_Read = Latin_Capital_Letter_Y then
                        Id.Typ := Entity;
                        Put_In_Buffer (Parser, Parser.Last_Read);
                        Next_Char (Input, Parser);
                     else
                        Fatal_Error
                          (Parser, "[WF] Unexpected type in ATTLIST");
                     end if;

                  elsif Parser.Last_Read = Latin_Capital_Letter_I
                    and then Looking_At (Id_Sequence)
                  then
                     if Looking_At (Ref_Sequence) then
                        if Parser.Last_Read = Latin_Capital_Letter_S then
                           Id.Typ := Idrefs;
                           Put_In_Buffer (Parser, Parser.Last_Read);
                           Next_Char (Input, Parser);
                        else
                           Id.Typ := Idref;
                        end if;
                     else
                        Id.Typ := Id_Type;
                     end if;

                  elsif Parser.Last_Read = Latin_Capital_Letter_N then
                     Next_Char (Input, Parser);
                     if Looking_At (Mtoken_Sequence) then
                        if Parser.Last_Read = Latin_Capital_Letter_S then
                           Id.Typ := Nmtokens;
                           Next_Char (Input, Parser);
                        else
                           Id.Typ := Nmtoken;
                        end if;
                     elsif Looking_At (Otation_Sequence) then
                        Id.Typ := Notation;
                     else
                        Fatal_Error
                          (Parser, "[WF] Invalid type for attribute");
                     end if;

                  elsif Parser.Last_Read = Number_Sign then
                     Put_In_Buffer (Parser, Parser.Last_Read);
                     Next_Char (Input, Parser);
                     if Looking_At (Implied_Sequence) then
                        Id.Typ := Implied;
                     elsif Looking_At (Required_Sequence) then
                        Id.Typ := Required;
                     elsif Looking_At (Fixed_Sequence) then
                        Id.Typ := Fixed;
                     else
                        Fatal_Error (Parser, "[WF] Invalid keyword");
                     end if;
                  end if;
               end if;
         end case;

         --  try to coalesce as many things as possible into a single

         --  text event

         if Id.Typ = End_Of_Input then
            if Is_Letter (Parser.Last_Read)
              or else Parser.Last_Read = Spacing_Underscore
            then
               Id.Typ := Name;
               Put_In_Buffer (Parser, Parser.Last_Read);
               Next_Char (Input, Parser);
            else
               Id.Typ := Text;
            end if;
         end if;

         if Id.Typ = Name then
            while Is_Name_Char (Parser.Last_Read) loop
               Put_In_Buffer (Parser, Parser.Last_Read);
               Next_Char (Input, Parser);
            end loop;

         elsif Id.Typ = Text and then Is_Entity_Ref = None then
            while not Is_White_Space (Parser.Last_Read)
              and then (not Parser.State.Greater_Special
                        or else Parser.Last_Read /= Greater_Than_Sign)
              and then Parser.Last_Read /= Less_Than_Sign
              and then Parser.Last_Read /= Ampersand
              and then (not Parser.State.Expand_Param_Entities
                        or else Parser.Last_Read /= Percent_Sign)
              and then Parser.Last_Read /= Equals_Sign
              and then Parser.Last_Read /= Quotation_Mark
              and then Parser.Last_Read /= Apostrophe
              and then Parser.Last_Read /= Slash
              and then (Parser.Last_Read /= Question_Mark
                        or else not Parser.State.Detect_End_Of_PI)
            loop
               Put_In_Buffer (Parser, Parser.Last_Read);
               Next_Char (Input, Parser);
            end loop;
         end if;

         Parser.Ignore_State_Special := False;
      end if;

      Id.Last := Parser.Buffer_Length;

      if Debug_Lexical then
         Debug_Print;
      end if;

      --  Internal entities should be processes inline


      if Is_Entity_Ref /= None then
         declare
            N : constant Byte_Sequence := Value (Parser, Id, Id);
            V : Entity_Entry := Get (Parser.Entities, N);
            Null_Loc : Locator_Impl;
         begin
            Reset_Buffer (Parser, Id);
            if N = Lt_Sequence then
               Put_In_Buffer (Parser, Less_Than_Sign);
               Id.Typ := Text;
               Id.Last := Parser.Buffer_Length;
               Next_Char (Input, Parser);

            elsif N = Gt_Sequence then
               Put_In_Buffer (Parser, Greater_Than_Sign);
               Id.Typ := Text;
               Id.Last := Parser.Buffer_Length;
               Next_Char (Input, Parser);

            elsif N = Amp_Sequence then
               Put_In_Buffer (Parser, Ampersand);
               Id.Typ := Text;
               Id.Last := Parser.Buffer_Length;
               Next_Char (Input, Parser);

            elsif N = Apos_Sequence then
               Put_In_Buffer (Parser, Apostrophe);
               Id.Typ := Text;
               Id.Last := Parser.Buffer_Length;
               Next_Char (Input, Parser);

            elsif N = Quot_Sequence then
               Put_In_Buffer (Parser, Quotation_Mark);
               Id.Typ := Text;
               Id.Last := Parser.Buffer_Length;
               Next_Char (Input, Parser);

            elsif V = Null_Entity then
               Skipped_Entity (Parser, N);
               Error (Parser, "[4.1] Undefined entity '" & N & ''', Id);
               Id.Typ := Text;
               Id.Last := Id.First - 1;
               Next_Char (Input, Parser);

            else
               if Is_Entity_Ref = Entity
                 and then Parser.Current_Node = null
                 and then not Parser.State.In_DTD
               then
                  Fatal_Error
                    (Parser,
                     "[2.1] Entity references can not appear at top-level",
                     Id);

               --  Else if we are in the internal subset of the DTD, and in

               --  a context other than a declaration

               elsif Is_Entity_Ref = Param_Entity
                 and then not Parser.In_External_Entity
                 and then Parser.State.Name /= DTD_State.Name
               then
                  Fatal_Error
                    (Parser, "[WF PE in internal subset] Parameter entities"
                     & " cannot occur in attribute values", Id);
               end if;

               Close_Inputs (Parser);

               --  not in string context

               if not Parser.State.Ignore_Special then
                  Start_Entity (Parser, N);
               end if;

               if V.Already_Read then
                  Fatal_Error
                    (Parser, "(4.1) Entity can not reference itself", Id);
               end if;

               V.Already_Read := True;
               Set (Parser.Entities, N, V);

               Parser.Element_Id := Parser.Element_Id + 1;
               Parser.Inputs := new Entity_Input_Source'
                 (External       => V.External,
                  Name           => new Byte_Sequence' (N),
                  Input          => null,
                  Save_Loc       => Null_Loc,
                  Id             => Parser.Element_Id,
                  Handle_Strings => not Parser.State.Ignore_Special,
                  Next           => Parser.Inputs);
               Copy (Parser.Inputs.Save_Loc, Parser.Locator.all);

               if V.External then
                  if Parser.State.Name = Attlist_Str_Def_State.Name
                    or else Parser.State.Name = Attr_Value_State.Name
                  then
                     Fatal_Error
                       (Parser, "[3.1] Attribute values can not reference"
                        & " external entities", Id);
                  end if;

                  declare
                     URI : constant Byte_Sequence :=
                       Resolve_URI (Parser, V.Value.all);
                  begin
                     Parser.Inputs.Input := new File_Input;
                     Open (URI, File_Input (Parser.Inputs.Input.all));
                     Set_System_Id (Parser.Locator.all, URI);
                     Set_Public_Id (Parser.Locator.all, V.Value.all);
                     Parser.In_External_Entity := True;
                  exception
                     when Name_Error =>
                        Error (Parser,
                               "External entity not found: " & URI, Id);
                  end;
               else
                  Parser.Inputs.Input := new String_Input;
                  Open (V.Value, Encoding,
                        String_Input (Parser.Inputs.Input.all));
                  Set_Public_Id (Parser.Locator.all, "entity " & N);
               end if;

               Set_Public_Id
                 (Parser.Inputs.Input.all, Get_Public_Id (Parser.Locator.all));
               Set_Line_Number (Parser.Locator.all, 1);
               Set_Column_Number
                 (Parser.Locator.all,
                  1 + Prolog_Size (Parser.Inputs.Input.all));

               Next_Char (Input, Parser);
               Next_Token (Input, Parser, Id);

               V.Already_Read := False;
               Set (Parser.Entities, N, V);
            end if;
         end;
      end if;

   exception
      when Input_Ended =>
            --  Make sure we always emit the last characters in the buffer

         Id.Last := Parser.Buffer_Length;
         if Debug_Lexical then
            Debug_Print;
         end if;

         if Id.Typ = Cdata_Section then
            Fatal_Error
              (Parser, "[2.7] CDATA sections must end with ']]>'", Id);
         elsif Id.Typ = Comment then
            Fatal_Error
              (Parser, "[2.5] Comments must end with '-->'", Id);

         end if;
   end Next_Token;

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

   -- Next_Token_Skip_Spaces --

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


   procedure Next_Token_Skip_Spaces
     (Input  : in out Input_Sources.Input_Source'Class;
      Parser : in out Reader'Class;
      Id     : out Token;
      Must_Have : Boolean := False) is
   begin
      Next_Token (Input, Parser, Id);
      if Must_Have and then Id.Typ /= Space then
         Fatal_Error (Parser, "Expecting a space", Id);
      end if;
      while Id.Typ = Space loop
         Reset_Buffer (Parser, Id);
         Next_Token (Input, Parser, Id);
      end loop;
   end Next_Token_Skip_Spaces;

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

   -- Reset_Buffer --

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


   procedure Reset_Buffer
     (Parser : in out Reader'Class; Id : Token := Null_Token) is
   begin
      Parser.Buffer_Length := Id.First - 1;
   end Reset_Buffer;

   -----------

   -- Value --

   -----------


   function Value (Parser : Reader'Class; From, To : Token)
      return Unicode.CES.Byte_Sequence is
   begin
      if To = Null_Token then
         return "";
      else
         pragma Assert (Parser.Buffer_Length >= To.Last);
         return Parser.Buffer (From.First .. To.Last);
      end if;
   end Value;

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

   -- Set_State --

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


   procedure Set_State
     (Parser : in out Reader'Class; State : Parser_State) is
   begin
      Parser.State := State;
   end Set_State;

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

   -- Get_State --

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


   function Get_State (Parser : Reader'Class) return Parser_State is
   begin
      return Parser.State;
   end Get_State;

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

   -- Parse_Element_Model --

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


   procedure Parse_Element_Model
     (Input   : in out Input_Source'Class;
      Parser  : in out Reader'Class;
      Result  : out Element_Model_Ptr;
      Nmtokens : Boolean := False;
      Attlist : Boolean := False;
      Open_Was_Read : Boolean)
   is
      --  ??? Would be nice to get rid of this hard-coded limitation in stacks

      Stack_Size : constant Natural := 64;
      Operand_Stack : Element_Model_Array (1 .. Stack_Size);
      Operand_Index : Natural := Operand_Stack'First;
      Operator_Stack : array (1 .. Stack_Size) of Unicode_Char;
      Operator_Index : Natural := Operator_Stack'First;
      Num_Items : Positive;
      Current_Item, Current_Operand : Natural;
      Expect_Operator : Boolean := not Open_Was_Read;
      Start_Sub : Natural;
      M : Element_Model_Ptr;
      Found : Boolean;
      Start_Id : constant Natural := Input_Id (Parser);
      Start_Token : Token;
      Test_Multiplier : Boolean;
      Can_Be_Mixed : Boolean;

   begin
      Start_Token.Line := Get_Line_Number (Parser.Locator.all);
      Start_Token.Column := Get_Column_Number (Parser.Locator.all) - 1;

      if Open_Was_Read then
         --  Insert the opening parenthesis into the operators stack

         Operator_Stack (Operator_Stack'First) := Opening_Parenthesis;
         Operator_Index := Operator_Index + 1;
         Start_Token.Column := Start_Token.Column - 1;
      end if;

      while Is_White_Space (Parser.Last_Read) loop
         Next_Char (Input, Parser);
      end loop;

      loop
         if Input_Id (Parser) /= Start_Id then
            Fatal_Error (Parser, "[4.5] Entity values must be self-contained",
                         Start_Token);
         end if;

         Test_Multiplier := False;

         --  Process the operator

         case Parser.Last_Read is
            when Opening_Parenthesis =>
               Operator_Stack (Operator_Index) := Parser.Last_Read;
               Operator_Index := Operator_Index + 1;
               Expect_Operator := False;
               Next_Char (Input, Parser);

            when Closing_Parenthesis =>
               Num_Items := 1;
               Current_Item := Operator_Index - 1;
               Current_Operand := Operand_Index - 1;
               Can_Be_Mixed :=  Current_Operand >= Operand_Stack'First and then
                 (Operand_Stack (Current_Operand).Content = Character_Data
                  or else Operand_Stack (Current_Operand).Content
                  = Element_Ref);

               if Current_Operand >= Operand_Stack'First
                 and then Is_Mixed (Operand_Stack (Current_Operand))
               then
                  Fatal_Error
                    (Parser, "[3.2.1] Mixed contents can not be used in"
                     & " a list or a sequence");
               end if;

               while Current_Item >= Operator_Stack'First
                 and then Operator_Stack (Current_Item) /= Opening_Parenthesis
               loop
                  if Operator_Stack (Current_Item) /= Comma
                    and then Operator_Stack (Current_Item) /= Vertical_Line
                  then
                     Fatal_Error
                       (Parser, "Invalid content model", Start_Token);
                  end if;

                  Current_Operand := Current_Operand - 1;

                  if Operand_Stack (Current_Operand).Content /= Character_Data
                    and then
                    Operand_Stack (Current_Operand).Content /= Element_Ref
                  then
                     Can_Be_Mixed := False;
                  end if;

                  if Is_Mixed (Operand_Stack (Current_Operand)) then
                     Fatal_Error
                       (Parser, "[3.2.1] Mixed contents can not be used in"
                        & " a list or a sequence");
                  end if;

                  Num_Items := Num_Items + 1;
                  Current_Item := Current_Item - 1;
               end loop;
               if Current_Item < Operator_Stack'First then
                  Fatal_Error (Parser, "Invalid content model", Start_Token);
               end if;
               if Current_Operand < Operand_Stack'First then
                  Fatal_Error
                    (Parser, "Invalid content model: "
                     & "List of choices cannot be empty", Start_Token);
               end if;

               if Operator_Stack (Operator_Index - 1) = Comma then
                  M := new Element_Model (Sequence);
               else
                  if not Can_Be_Mixed
                    and then Operand_Stack (Current_Operand).Content
                     = Character_Data
                  then
                     Fatal_Error
                       (Parser, "[3.2.2] Nested groups and occurence operators"
                        & " not allowed in mixed content");
                  end if;

                  M := new Element_Model (Any_Of);
               end if;
               M.List := new Element_Model_Array (1 .. Num_Items);
               for J in Current_Operand .. Operand_Index - 1 loop
                  M.List (J - Current_Operand + 1) := Operand_Stack (J);
               end loop;
               Operand_Index := Current_Operand + 1;
               Operand_Stack (Current_Operand) := M;
               Operator_Index := Current_Item;
               Expect_Operator := False;
               Next_Char (Input, Parser);
               Test_Multiplier := True;

            when Comma | Vertical_Line =>
               if Attlist and then Parser.Last_Read = Comma then
                  Fatal_Error
                    (Parser,
                     "[3.3.1] Invalid character ',' in ATTLIST enumeration");
               end if;

               if Parser.Last_Read = Comma
                 and then Operator_Stack (Operator_Index - 1)
                   = Opening_Parenthesis
                 and then Operand_Stack (Operand_Index - 1).Content
                   = Character_Data
               then
                  Fatal_Error
                    (Parser,
                     "[3.2.2] #PCDATA can only be used with '|' connectors");
               end if;

               if Operator_Index = Operator_Stack'First
                 or else
                 (Operator_Stack (Operator_Index - 1) /= Parser.Last_Read
                  and then
                  Operator_Stack (Operator_Index - 1) /= Opening_Parenthesis)
               then
                  Fatal_Error
                    (Parser, "Can't mix ',' and '|' in content model");
               end if;
               Operator_Stack (Operator_Index) := Parser.Last_Read;
               Operator_Index := Operator_Index + 1;
               Expect_Operator := False;
               Next_Char (Input, Parser);

            when Star | Question_Mark | Plus_Sign =>
               Fatal_Error
                 (Parser, "[3.2.1] Invalid location '+', '?' or '*' "
                  & "operator", Start_Token);

            when Number_Sign =>
               if Expect_Operator then
                  Fatal_Error (Parser, "Invalid content model", Start_Token);
               end if;
               Expect_Operator := True;

               --  #PCDATA can only be the first element of a choice list

               --  ??? Note that in that case the Choice model can only be a

               --  list of names, not a parenthesis expression.

               Start_Sub := Parser.Buffer_Length + 1;

               Next_Char (Input, Parser);
               Found := (Parser.Last_Read = Latin_Capital_Letter_P);
               if Found then
                  Next_Char (Input, Parser);
                  Found := (Parser.Last_Read = Latin_Capital_Letter_C);
                  if Found then
                     Next_Char (Input, Parser);
                     Found := (Parser.Last_Read = Latin_Capital_Letter_D);
                     if Found then
                        Next_Char (Input, Parser);
                        Found := (Parser.Last_Read = Latin_Capital_Letter_A);
                        if Found then
                           Next_Char (Input, Parser);
                           Found :=
                             (Parser.Last_Read = Latin_Capital_Letter_T);
                           if Found then
                              Next_Char (Input, Parser);
                              Found :=
                                (Parser.Last_Read = Latin_Capital_Letter_A);
                           end if;
                        end if;
                     end if;
                  end if;
               end if;

               if not Found then
                  Fatal_Error
                    (Parser, "[WF] Invalid sequence in content model",
                     Start_Token);
               end if;

               if Operator_Stack (Operator_Index - 1)
                 /= Opening_Parenthesis
               then
                  Fatal_Error
                    (Parser, "[3.2.2] #PCDATA must be first in list");
               end if;

               Next_Char (Input, Parser);
               Operand_Stack (Operand_Index) :=
                 new Element_Model (Character_Data);
               Operand_Index := Operand_Index + 1;
               Parser.Buffer_Length := Start_Sub - 1;

            when Percent_Sign =>
               if not Parser.In_External_Entity
                 and then Parser.State.Name /= DTD_State.Name
               then
                  Fatal_Error
                    (Parser, "[WF PE in internal subset] Parameter entities"
                     & " cannot occur in attribute values");
               end if;

               Expect_Operator := True;
               Start_Sub := Parser.Buffer_Length + 1;

               while Parser.Last_Read /= Semicolon loop
                  Put_In_Buffer (Parser, Parser.Last_Read);
                  Next_Char (Input, Parser);
               end loop;
               Next_Char (Input, Parser);

               Parse_Element_Model_From_Entity
                    (Parser, Parser.Buffer (Start_Sub .. Parser.Buffer_Length),
                     Operand_Stack (Operand_Index), Attlist);
               if Operand_Stack (Operand_Index) /= null then
                  Operand_Index := Operand_Index + 1;
               end if;
               Parser.Buffer_Length := Start_Sub - 1;
               Test_Multiplier := True;

            when others =>
               if Expect_Operator then
                  Fatal_Error  (Parser, "Expecting operator in content model");
               end if;
               Expect_Operator := True;

               --  ??? Should test Is_Nmtoken

               Start_Sub := Parser.Buffer_Length + 1;

               while Parser.Last_Read = Unicode.Names.Basic_Latin.Colon
                 or else Is_Name_Char (Parser.Last_Read)
               loop
                  Put_In_Buffer (Parser, Parser.Last_Read);
                  Next_Char (Input, Parser);
               end loop;

               if Start_Sub > Parser.Buffer_Length then
                  Fatal_Error (Parser, "Invalid name in content model: "
                               & Encoding.Encode (Parser.Last_Read),
                               Start_Token);
               end if;

               Operand_Stack (Operand_Index) :=
                 new Element_Model (Element_Ref);
               Operand_Stack (Operand_Index).Name := new Byte_Sequence'
                 (Parser.Buffer (Start_Sub .. Parser.Buffer_Length));
               Operand_Index := Operand_Index + 1;
               Parser.Buffer_Length := Start_Sub - 1;
               Test_Multiplier := True;

         end case;

         if Test_Multiplier then
            case Parser.Last_Read is
               when Star =>
                  if Operand_Index = Operand_Stack'First then
                     Fatal_Error
                       (Parser, "'*' must follow a name or list");
                  end if;
                  Operand_Stack (Operand_Index - 1) := new Element_Model'
                    (Repeat, 0, Positive'Last,
                     Operand_Stack (Operand_Index - 1));
                  Expect_Operator := True;
                  Next_Char (Input, Parser);

               when Plus_Sign =>
                  if Operand_Index = Operand_Stack'First then
                     Fatal_Error
                       (Parser, "'+' must follow a name or list");
                  end if;
                  if Is_Mixed (Operand_Stack (Operand_Index - 1)) then
                     Fatal_Error
                       (Parser, "[3.2.2] Occurence on #PCDATA must be '*'");
                  end if;

                  Operand_Stack (Operand_Index - 1) := new Element_Model'
                    (Repeat, 1,
                     Positive'Last, Operand_Stack (Operand_Index - 1));
                  Expect_Operator := True;
                  Next_Char (Input, Parser);

               when Question_Mark =>
                  if Operand_Index = Operand_Stack'First then
                     Fatal_Error
                       (Parser, "'?' must follow a name or list");
                  end if;
                  if Is_Mixed (Operand_Stack (Operand_Index - 1)) then
                     Fatal_Error
                       (Parser, "[3.2.2] Occurence on #PCDATA must be '*'");
                  end if;
                  Operand_Stack (Operand_Index - 1) := new Element_Model'
                    (Repeat, 0, 1, Operand_Stack (Operand_Index - 1));
                  Expect_Operator := True;
                  Next_Char (Input, Parser);

               when others => null;
            end case;
         end if;

         exit when Operator_Index = Operator_Stack'First
           and then Operand_Index = Operand_Stack'First + 1;

         while Is_White_Space (Parser.Last_Read) loop
            Next_Char (Input, Parser);
         end loop;
      end loop;

      if Operator_Index /= Operator_Stack'First
        or else Operand_Index /= Operand_Stack'First + 1
      then
         Fatal_Error (Parser, "Invalid content model", Start_Token);
      end if;

      Result := Operand_Stack (Operand_Stack'First);

   exception
      when Input_Ended =>
         if Operator_Index /= Operator_Stack'First
           or else Operand_Index /= Operand_Stack'First + 1
         then
            for J in Operand_Stack'First .. Operand_Index - 1 loop
               Free (Operand_Stack (J));
            end loop;
            Fatal_Error (Parser, "Invalid content model", Start_Token);
         end if;
         Result := Operand_Stack (Operand_Stack'First);

      when others =>
         for J in Operand_Stack'First .. Operand_Index - 1 loop
            Free (Operand_Stack (J));
         end loop;
         raise;
   end Parse_Element_Model;

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

   -- Parse_Element_Model_From_Entity --

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


   procedure Parse_Element_Model_From_Entity
     (Parser : in out Reader'Class;
      Name   : Byte_Sequence;
      M      : out Element_Model_Ptr;
      Attlist : Boolean := False)
   is
      Loc : Locator_Impl;
      Last : constant Unicode_Char := Parser.Last_Read;
      Input_S : String_Input;
      Val : Entity_Entry := Get (Parser.Entities, Name);
   begin
      if Val = Null_Entity then
         Put_Line ("Unknown entity " & Name);
         M := null;

      elsif Val.Value.all = "" then
         M := null;

      else
         Copy (Loc, Parser.Locator.all);
         Set_Line_Number (Parser.Locator.all, 1);
         Set_Column_Number (Parser.Locator.all, 1);
         Set_Public_Id (Parser.Locator.all, "entity " & Name);

         Open (Val.Value, Encoding, Input_S);
         Next_Char (Input_S, Parser);
         Parse_Element_Model (Input_S, Parser, M, False, Attlist, False);
         Close (Input_S);

         Copy (Parser.Locator.all, Loc);
         Free (Loc);
         Parser.Last_Read := Last;
      end if;
   end Parse_Element_Model_From_Entity;

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

   -- Syntactic_Parse --

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


   procedure Syntactic_Parse
     (Parser : in out Reader'Class;
      Input  : in out Input_Sources.Input_Source'Class)
   is
      Id  : Token := Null_Token;

      procedure Parse_Start_Tag;
      --  Process an element start and its attributes   <!name name="value"..>


      procedure Parse_End_Tag;
      --  Process an element end   </name>


      procedure Parse_Doctype;
      --  Process the DTD declaration


      procedure Parse_Doctype_Contents;
      --  Process the DTD's contents


      procedure Parse_Entity_Def (Id : in out Token);
      --  Parse an <!ENTITY declaration


      procedure Parse_Element_Def (Id : in out Token);
      --  Parse an <!ELEMENT declaration


      procedure Parse_Notation_Def (Id : in out Token);
      --  Parse an <!NOTATION declaration


      procedure Parse_Attlist_Def (Id : in out Token);
      --  Parse an <!ATTLIST declaration


      procedure Parse_PI (Id : in out Token);
      --  Parse a <?...?> processing instruction


      procedure End_Element (NS_Id, Name_Id : Token);
      --  End the current element. Its namespace prefix and local_name are

      --  given in the parameters.


      procedure Get_String
        (Id : in out Token;
         State : Parser_State;
         Str_Start, Str_End : out Token;
         Normalize : Boolean := False);
      --  Get all the character till the end of the string. Id should contain

      --  the initial quote that starts the string.

      --  On exit, Str_Start is set to the first token of the string, and

      --  Str_End to the last token.


      procedure Get_Name_NS (Id : in out Token; NS_Id, Name_Id : out Token);
      --  Read the next tokens so as to match either a single name or

      --  a "ns:name" name.

      --  Id should initially point to the candidate token for the name, and

      --  will be left on the token following that name.

      --  An error is raised if we can't even match a Name.


      procedure Get_External
        (Id : in out Token;
         System_Start, System_End, Public_Start, Public_End : out Token;
         Allow_Publicid : Boolean := False);
      --  Parse a PUBLIC or SYSTEM definition and its arguments.

      --  Id should initially point to the keyword itself, and will be set to

      --  the first identifier following the full definition

      --  If Allow_Publicid is True, then PUBLIC might be followed by a single

      --  string, as in rule [83] of the XML specifications.


      procedure Check_Standalone_Value;
      procedure Check_Encoding_Value;
      procedure Check_Version_Value;
      --  Check the arguments for the <?xml?> processing instruction.

      --  Each of this procedures gets the arguments from Next_Token, up to,

      --  and including, the following space or End_Of_PI character.

      --  They raise errors appropriately


      procedure Check_Model;
      --  Check that the last element inserted matches the model. This

      --  procedure should not be called for the root element.


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

      -- Get_String --

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


      procedure Get_String
        (Id : in out Token;
         State : Parser_State;
         Str_Start, Str_End : out Token;
         Normalize : Boolean := False)
      is
         T : constant Token := Id;
         Saved_State : constant Parser_State := Get_State (Parser);
         Possible_End : Token := Null_Token;
         C : Unicode_Char;
         Index : Natural;
         Last_Space : Natural := 0;
         Had_Space : Boolean := Normalize;  --  Avoid leading spaces


      begin
         Set_State (Parser, State);
         Next_Token (Input, Parser, Id);
         Str_Start := Id;
         Str_End := Id;

         while Id.Typ /= T.Typ and then Id.Typ /= End_Of_Input loop
            Str_End := Id;
            case Id.Typ is
               when Double_String_Delimiter =>
                  Str_End.First := Parser.Buffer_Length + 1;
                  Put_In_Buffer (Parser, Quotation_Mark);
                  Str_End.Last := Parser.Buffer_Length;
                  Possible_End := Str_End;
                  Had_Space := False;
               when Single_String_Delimiter =>
                  Str_End.First := Parser.Buffer_Length + 1;
                  Put_In_Buffer (Parser, Apostrophe);
                  Str_End.Last := Parser.Buffer_Length;
                  Possible_End := Str_End;
                  Had_Space := False;
               when Start_Of_Tag =>
                  if Possible_End = Null_Token then
                     Fatal_Error
                       (Parser, "[2.3] '<' not authorized in attribute values",
                        Id);
                  else
                     Fatal_Error
                       (Parser, "[2.3] '<' not authorized in attribute values."
                        & " Possible end of attribute value at "
                        & Location (Parser, Possible_End), Id);
                  end if;
               when others =>
                  if Normalize then
                     declare
                        Str : constant Byte_Sequence := Value (Parser, Id, Id);
                     begin
                        Reset_Buffer (Parser, Id);
                        Index := Str'First;
                        while Index <= Str'Last loop
                           C := Encoding.Read (Str, Index);
                           Index := Index + Encoding.Width (C);
                           if Is_White_Space (C) then
                              if not Had_Space then
                                 Put_In_Buffer
                                   (Parser, Unicode.Names.Basic_Latin.Space);
                              end if;
                              Had_Space := True;
                              Last_Space := Parser.Buffer_Length;
                           else
                              Had_Space := False;
                              Put_In_Buffer (Parser, C);
                           end if;
                        end loop;
                     end;
                     Str_End.Last := Parser.Buffer_Length;
                  end if;
            end case;
            Next_Token (Input, Parser, Id);
         end loop;

         if Normalize and then Had_Space and then Last_Space /= 0 then
            Str_End.Last := Last_Space - 1;
         end if;

         if Id.Typ = End_Of_Input then
            if Possible_End = Null_Token then
               Fatal_Error
                 (Parser, "[2.3] Unterminated string");
            else
               Fatal_Error
                 (Parser, "[2.3] Unterminated string, possible end at "
                  & Location (Parser, Possible_End), T);
            end if;
         end if;
         Set_State (Parser, Saved_State);
      end Get_String;

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

      -- Get_External --

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


      procedure Get_External
        (Id : in out Token;
         System_Start, System_End, Public_Start, Public_End : out Token;
         Allow_Publicid : Boolean := False)
      is
         Had_Space : Boolean;
         C : Unicode_Char;
         Index : Natural;
      begin
         System_Start := Null_Token;
         System_End := Null_Token;
         Public_Start := Null_Token;
         Public_End := Null_Token;

         --  Check the arguments for PUBLIC

         if Id.Typ = Public then
            Next_Token_Skip_Spaces (Input, Parser, Id, Must_Have => True);
            if Id.Typ /= Double_String_Delimiter
              and then Id.Typ /= Single_String_Delimiter
            then
               Fatal_Error (Parser, "[WF] Expecting string after PUBLIC");
            else
               Get_String
                 (Id, Non_Interpreted_String_State, Public_Start, Public_End);

               Index := Public_Start.First;
               while Index <= Public_End.Last loop
                  C := Encoding.Read (Parser.Buffer, Index);
                  Index := Index + Encoding.Width (C);

                  if not Is_Pubid_Char (C) then
                     Fatal_Error
                       (Parser, "Invalid PubID character '"
                        & Encoding.Encode (C) & "'", Public_Start);
                  end if;
               end loop;
            end if;

            Next_Token (Input, Parser, Id);
            Had_Space := (Id.Typ = Space);
            if Had_Space then
               Next_Token (Input, Parser, Id);
            elsif Allow_Publicid then
               return;
            end if;

            if Id.Typ /= Double_String_Delimiter
              and then Id.Typ /= Single_String_Delimiter
            then
               if not Allow_Publicid then
                  Fatal_Error (Parser, "[WF] Expecting SystemID after PUBLIC");
               end if;
            else
               if not Had_Space then
                  Fatal_Error
                    (Parser, "[4.2.2] Require whitespace between public and"
                     & " system IDs", Id);
               end if;
               Get_String
                 (Id, Non_Interpreted_String_State, System_Start, System_End);
               Next_Token (Input, Parser, Id);
            end if;

            --  Check the arguments for SYSTEM

         elsif Id.Typ = System then
            Next_Token_Skip_Spaces (Input, Parser, Id, Must_Have => True);
            if Id.Typ /= Double_String_Delimiter
              and then Id.Typ /= Single_String_Delimiter
            then
               Fatal_Error (Parser, "[WF] Expecting string after SYSTEM");
            else
               Get_String
                 (Id, Non_Interpreted_String_State, System_Start, System_End);
               Next_Token (Input, Parser, Id);
            end if;
         end if;
      end Get_External;

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

      -- Get_Name_NS --

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


      procedure Get_Name_NS (Id : in out Token; NS_Id, Name_Id : out Token) is
      begin
         Name_Id := Id;

         if Id.Typ = Text then
            Fatal_Error
              (Parser, "[3.1] '" & Value (Parser, Id, Id)
               & "' is not a valid name", Id);
         --  An empty namespace ? This seems to be useful only for the XML

         --  conformance suite, so we only handle the case of a single ':'

         --  to mean both an empty prefix and empty local name.

         elsif Name_Id.Typ = Colon then
            Name_Id.Typ := Text;
            NS_Id := Name_Id;
            Next_Token (Input, Parser, Id);

         elsif Id.Typ /= Name then
            Fatal_Error (Parser, "Expecting a name", Id);

         else
            Next_Token (Input, Parser, Id);
            if Id.Typ = Colon then
               NS_Id := Name_Id;
               Next_Token (Input, Parser, Name_Id);
               if Name_Id.Typ /= Name then
                  Fatal_Error (Parser, "[WF] Expecting name after namespace");
               end if;
               Next_Token (Input, Parser, Id);
            else
               NS_Id := Null_Token;
            end if;
         end if;
      end Get_Name_NS;

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

      -- Parse_Entity_Def --

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


      procedure Parse_Entity_Def (Id : in out Token) is
         Is_Parameter : Token := Null_Token;
         Name_Id : Token;
         Def_Start, Def_End : Token := Null_Token;
         Ndata_Id : Token := Null_Token;
         Public_Start, Public_End : Token := Null_Token;
         System_Start, System_End : Token := Null_Token;
         Had_Space : Boolean;
      begin
         Set_State (Parser, Entity_Def_State);
         Next_Token_Skip_Spaces (Input, Parser, Name_Id, True);

         if Name_Id.Typ = Text
           and then Value (Parser, Name_Id, Name_Id) =
           Encoding.Encode (Percent_Sign)
         then
            Is_Parameter := Name_Id;
            Next_Token_Skip_Spaces (Input, Parser, Name_Id);
         end if;

         if Name_Id.Typ /= Name then
            Fatal_Error (Parser, "[WF] Expecting entity name");
         end if;

         Next_Token_Skip_Spaces (Input, Parser, Id, Must_Have => True);

         if Id.Typ = Public or else Id.Typ = System then
            Get_External
              (Id, System_Start, System_End, Public_Start, Public_End);

            Had_Space := (Id.Typ = Space);
            if Had_Space then
               Next_Token (Input, Parser, Id);
            end if;

            if Id.Typ = Ndata then
               if not Had_Space then
                  Fatal_Error
                    (Parser,
                     "[4.2.2] Expecting space before NDATA declaration", Id);
               end if;

               if Is_Parameter /= Null_Token then
                  Fatal_Error
                    (Parser, "[4.2] NDATA annotation not allowed for parameter"
                     & " entities", Id);
               end if;
               Next_Token_Skip_Spaces (Input, Parser, Ndata_Id, True);
               if Ndata_Id.Typ /= Text and then Ndata_Id.Typ /= Name then
                  Fatal_Error (Parser, "[WF] Expecting string after NDATA");
               else
                  if Parser.Feature_Validation
                    and then not Get (Parser.Notations,
                                      Value (Parser, Ndata_Id, Ndata_Id))
                  then
                     Fatal_Error
                       (Parser, "[VC 4.2.2] Notation '"
                        & Value (Parser, Ndata_Id, Ndata_Id) & "' must be"
                        & " declared", Ndata_Id);
                  end if;

                  Next_Token_Skip_Spaces (Input, Parser, Id);
               end if;
            end if;

         elsif Id.Typ = Double_String_Delimiter
           or else Id.Typ = Single_String_Delimiter
         then
            Get_String (Id, Entity_Str_Def_State, Def_Start, Def_End);
            Next_Token_Skip_Spaces (Input, Parser, Id);
         else
            Fatal_Error (Parser, "[WF] Invalid definition for ENTITY");
         end if;

         if Id.Typ /= End_Of_Tag then
            Fatal_Error (Parser, "[WF] Expecting end of ENTITY definition");
         end if;

         --  Only report the first definition

         if Get (Parser.Entities,
                 Value (Parser, Is_Parameter, Is_Parameter)
                 & Value (Parser, Name_Id, Name_Id)) /= Null_Entity
         then
            null;

         elsif Def_End /= Null_Token then
            Set (Parser.Entities,
                 Value (Parser, Is_Parameter, Is_Parameter)
                 & Value (Parser, Name_Id, Name_Id),
                 (new Byte_Sequence' (Value (Parser, Def_Start, Def_End)),
                  External     => False,
                  Already_Read => False));
            Internal_Entity_Decl
              (Parser,
               Name => Value (Parser, Is_Parameter, Is_Parameter)
               & Value (Parser, Name_Id, Name_Id),
               Value => Value (Parser, Def_Start, Def_End));

         elsif Ndata_Id /= Null_Token then
            Unparsed_Entity_Decl
              (Parser,
               Name => Value (Parser, Is_Parameter, Is_Parameter)
               & Value (Parser, Name_Id, Name_Id),
               System_Id => Value (Parser, System_Start, System_End),
               Notation_Name => Value (Parser, Ndata_Id, Ndata_Id));

         else
            Set
              (Parser.Entities,
               Value (Parser, Is_Parameter, Is_Parameter)
               & Value (Parser, Name_Id, Name_Id),
               (new Byte_Sequence' (Value (Parser, System_Start, System_End)),
                External => True,
                Already_Read => False));
            External_Entity_Decl
              (Parser,
               Name => Value (Parser, Is_Parameter, Is_Parameter)
               & Value (Parser, Name_Id, Name_Id),
               Public_Id => Value (Parser, Public_Start, Public_End),
               System_Id => Value (Parser, System_Start, System_End));
         end if;

         if Is_Parameter /= Null_Token then
            Reset_Buffer (Parser, Is_Parameter);
         else
            Reset_Buffer (Parser, Name_Id);
         end if;
         Set_State (Parser, DTD_State);
      end Parse_Entity_Def;

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

      -- Parse_Element_Def --

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


      procedure Parse_Element_Def (Id : in out Token) is
         Name_Id : Token;
         M : Element_Model_Ptr;
      begin
         Set_State (Parser, Element_Def_State);
         Next_Token_Skip_Spaces (Input, Parser, Name_Id);

         if Name_Id.Typ /= Name then
            Fatal_Error (Parser, "[WF] Expecting element name");
         end if;

         Next_Token_Skip_Spaces (Input, Parser, Id, True);
         case Id.Typ is
            when Empty  => M := new Element_Model (Empty);
            when Any    => M := new Element_Model (Anything);
            when Open_Paren =>
               Parse_Element_Model
                 (Input, Parser, M, Nmtokens => False,
                  Attlist => False, Open_Was_Read => True);
            when others =>
               Fatal_Error (Parser, "[WF] Invalid content model: expecting"
                            & " '(', 'EMPTY' or 'ANY'", Id);
         end case;
         Next_Token_Skip_Spaces (Input, Parser, Id);

         if Id.Typ /= End_Of_Tag then
            Fatal_Error (Parser, "[WF] Expecting end of ELEMENT definition");
         end if;

         Element_Decl (Parser, Value (Parser, Name_Id, Name_Id), M);
         Free (M);

         Reset_Buffer (Parser, Name_Id);
         Set_State (Parser, DTD_State);
      end Parse_Element_Def;

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

      -- Parse_Notation_Def --

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


      procedure Parse_Notation_Def (Id : in out Token) is
         Public_Start, Public_End : Token := Null_Token;
         System_Start, System_End : Token := Null_Token;
         Name_Id : Token;
      begin
         Set_State (Parser, Element_Def_State);
         Next_Token_Skip_Spaces (Input, Parser, Name_Id);

         if Name_Id.Typ /= Name then
            Fatal_Error (Parser, "[WF] Expecting notation name");
         end if;

         Next_Token_Skip_Spaces (Input, Parser, Id);

         if Id.Typ = Public or else Id.Typ = System then
            Get_External
              (Id, System_Start, System_End, Public_Start, Public_End, True);
            if Id.Typ = Space then
               Next_Token (Input, Parser, Id);
            end if;
         else
            Fatal_Error (Parser, "[WF] Invalid notation declaration");
         end if;

         if Id.Typ /= End_Of_Tag then
            Fatal_Error (Parser, "[WF] Expecting end of NOTATION definition");
         end if;

         Notation_Decl
           (Parser,
            Name => Value (Parser, Name_Id, Name_Id),
            Public_Id => Value (Parser, Public_Start, Public_End),
            System_Id => Value (Parser, System_Start, System_End));

         if Parser.Feature_Validation then
            Set (Parser.Notations, Value (Parser, Name_Id, Name_Id), True);
         end if;

         Set_State (Parser, DTD_State);
         Reset_Buffer (Parser, Name_Id);
      end Parse_Notation_Def;

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

      -- Parse_Attlist_Def --

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


      procedure Parse_Attlist_Def (Id : in out Token) is
         M : Element_Model_Ptr;
         Default_Start, Default_End : Token;
         Ename_Id, Name_Id, NS_Id, Type_Id : Token;
         Default_Id : Token;
         Attr : Attributes_Ptr;
         NS : XML_NS;
         Default_Decl : Default_Declaration;
         Att_Type : Attribute_Type;
      begin
         Set_State (Parser, Element_Def_State);
         Next_Token_Skip_Spaces (Input, Parser, Ename_Id);

         if Ename_Id.Typ /= Name then
            Fatal_Error (Parser, "[WF] Expecting element name", Ename_Id);
         end if;

         Attr := Get (Parser.Default_Atts, Value (Parser, Ename_Id, Ename_Id));
         if Attr = null then
            Attr := new Sax.Attributes.Attributes;
         end if;

         loop
            Set_State (Parser, Attribute_Def_State);
            Next_Token_Skip_Spaces (Input, Parser, Id);
            exit when Id.Typ = End_Of_Tag or else Id.Typ = End_Of_Input;

            Get_Name_NS (Id, NS_Id, Name_Id);

            if Id.Typ /= Space then
               Fatal_Error
                 (Parser, "[3.3] Expecting space between attribute name"
                  & " and type", Id);
            end if;
            Next_Token (Input, Parser, Id);

            Type_Id := Id;
            Default_End := Null_Token;
            case Type_Id.Typ is
               when Id_Type  => Att_Type := Sax.Attributes.Id;
               when Idref    => Att_Type := Sax.Attributes.Idref;
               when Idrefs   => Att_Type := Sax.Attributes.Idrefs;
               when Cdata    => Att_Type := Sax.Attributes.Cdata;
               when Nmtoken  => Att_Type := Sax.Attributes.Nmtoken;
               when Nmtokens => Att_Type := Sax.Attributes.Nmtokens;
               when Entity   => Att_Type := Sax.Attributes.Entity;
               when Entities => Att_Type := Sax.Attributes.Entities;
               when Notation =>
                  Att_Type := Notation;
                  Next_Token (Input, Parser, Id);
                  if Id.Typ /= Space then
                     Fatal_Error
                       (Parser,
                        "[3.3.1] Space is required between NOTATION keyword"
                        & " and list of enumerated", Id);
                  end if;
                  Parse_Element_Model (Input, Parser, M, True, True, False);

                  if Parser.Feature_Validation then
                     for J in M.List'Range loop
                        if not Get (Parser.Notations, M.List (J).Name.all) then
                           Fatal_Error
                             (Parser,
                              "[VC 3.3.1] Notation '"
                              & M.List (J).Name.all & "' must be defined",
                              Id);
                        end if;
                     end loop;
                  end if;

               when Open_Paren =>
                  Att_Type := Enumeration;
                  Parse_Element_Model (Input, Parser, M, True, True, True);

               when others =>
                  Fatal_Error (Parser, "[WF] Invalid type for attribute");
            end case;

            Next_Token_Skip_Spaces (Input, Parser, Default_Id, True);
            if Default_Id.Typ = Implied then
               Default_Decl := Sax.Attributes.Implied;
            elsif Default_Id.Typ = Required then
               Default_Decl := Sax.Attributes.Required;
            else
               Id := Default_Id;
               if Default_Id.Typ = Fixed then
                  Next_Token_Skip_Spaces (Input, Parser, Id, True);
                  Default_Decl := Sax.Attributes.Fixed;
               else
                  Default_Decl := Sax.Attributes.Default;
               end if;

               if Id.Typ = Double_String_Delimiter
                 or else Id.Typ = Single_String_Delimiter
               then
                  Get_String
                    (Id, Attlist_Str_Def_State, Default_Start, Default_End,
                     Normalize => True);
               else
                  Fatal_Error
                    (Parser, "[WF] Invalid default value for attribute");
               end if;
            end if;

            --  Always report the attribute, even when we know the value

            --  won't be used. We can't do it coherently otherwise, in case

            --  an attribute is seen in the external subset, and then

            --  overriden in the internal subset.

            Attribute_Decl
              (Parser,
               Ename => Value (Parser, Ename_Id, Ename_Id),
               Aname => Qname_From_Name (Parser, NS_Id, Name_Id),
               Typ   => Att_Type,
               Content => M,
               Value_Default => Default_Decl,
               Value => Value (Parser, Default_Start, Default_End));

            Find_NS (Parser, Parser.Current_Node, NS_Id, NS);
            if Get_Index
              (Attr.all, NS.URI.all, Value (Parser, Name_Id, Name_Id)) = -1
            then
               Add_Attribute
                 (Attr.all,
                  NS.URI.all,
                  Value (Parser, Name_Id, Name_Id),
                  Qname_From_Name (Parser, NS_Id, Name_Id),
                  Att_Type,
                  M,
                  Value (Parser, Default_Start, Default_End),
                  Default_Decl);
            else
               Free (M);
            end if;

            if NS_Id /= Null_Token then
               Reset_Buffer (Parser, NS_Id);
            else
               Reset_Buffer (Parser, Name_Id);
            end if;
            Set_State (Parser, Element_Def_State);
         end loop;

         if Id.Typ /= End_Of_Tag then
            Fatal_Error (Parser, "[WF] Expecting end of ATTLIST definition");
         end if;

         --  Store the default attributes

         Set (Parser.Default_Atts, Value (Parser, Ename_Id, Ename_Id), Attr);

         Set_State (Parser, DTD_State);
         Reset_Buffer (Parser, Ename_Id);
      end Parse_Attlist_Def;

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

      -- Check_Model --

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


      procedure Check_Model is
      begin
         null;
      end Check_Model;

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

      -- Parse_Start_Tag --

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


      procedure Parse_Start_Tag is
         Open_Id : constant Token := Id;
         Value_Start, Value_End : Token;
         Elem_Name_Id, Elem_NS_Id : Token;
         Attr_Name_Id, Attr_NS_Id : Token;
         Add_Attr : Boolean;
         Attributes : Sax.Attributes.Attributes;
         NS : XML_NS;
         Attr : Attributes_Ptr;
         Found : Boolean;

      begin
         Set_State (Parser, Tag_State);

         Parser.Current_Node := new Element'
           (NS             => null,
            Name           => null,
            Namespaces     => null,
            Start_Id       => Id.Input_Id,
            Parent         => Parser.Current_Node);

         Next_Token (Input, Parser, Id);
         Get_Name_NS (Id, Elem_NS_Id, Elem_Name_Id);

         Parser.Current_Node.NS := new Byte_Sequence'
           (Value (Parser, Elem_NS_Id, Elem_NS_Id));
         Parser.Current_Node.Name := new Byte_Sequence'
           (Value (Parser, Elem_Name_Id, Elem_Name_Id));

         if Parser.Current_Node.Parent = null then
            Parser.Num_Toplevel_Elements := Parser.Num_Toplevel_Elements + 1;
            if Parser.Num_Toplevel_Elements > 1 then
               Fatal_Error
                 (Parser, "(2.1) Too many children for top-level node,"
                  & " when adding <"
                  & Qname_From_Name (Parser, Elem_NS_Id, Elem_Name_Id)
                  & ">", Open_Id);
            end if;

            if Parser.Feature_Validation
              and then Parser.DTD_Name = null
            then
               Fatal_Error
                 (Parser, "[VC 2.8] No DTD defined for this document", Id);
            end if;

            if Parser.Feature_Validation
              and then Parser.DTD_Name.all /= Parser.Current_Node.Name.all
            then
               Fatal_Error
                 (Parser, "[VC 2.8] Name of root element doesn't match name"
                  & " of DTD ('" & Parser.DTD_Name.all & "')", Id);
            end if;

         elsif Parser.Feature_Validation then
            Check_Model;
         end if;

         if Id.Typ = Space then
            Next_Token (Input, Parser, Id);
         elsif Id.Typ /= End_Of_Tag
           and then Id.Typ /= End_Of_Start_Tag
         then
            Fatal_Error
              (Parser, "[3] Must have spaces between tag name and attributes",
               Id);
         end if;

         --  ??? Should we support comments in tag_start

         while Id.Typ /= End_Of_Tag
           and then Id.Typ /= End_Of_Input
           and then Id.Typ /= End_Of_Start_Tag
         loop
            Get_Name_NS (Id, Attr_NS_Id, Attr_Name_Id);
            if Id.Typ = Space then
               Next_Token (Input, Parser, Id);
            end if;

            if Get_Index
              (Attributes,
               Qname_From_Name (Parser, Attr_NS_Id, Attr_Name_Id)) /= -1
            then
               Fatal_Error
                 (Parser, "(3.1) Attributes must have a unique name",
                  Attr_Name_Id);
            end if;

            if Id.Typ /= Equal then
               Fatal_Error
                 (Parser, "[3.1] Attributes must have an explicit value", Id);
            end if;

            Next_Token_Skip_Spaces (Input, Parser, Id);
            if Id.Typ /= Double_String_Delimiter
              and then Id.Typ /= Single_String_Delimiter
            then
               Fatal_Error
                 (Parser, "[3.1] Attribute values must be quoted", Id);
            end if;
            Get_String (Id, Attr_Value_State, Value_Start, Value_End,
                        Normalize => True); --  ??? All considered as CDATA


            Add_Attr := True;

            --  Is this a namespace declaration ?

            if Value (Parser, Attr_NS_Id, Attr_NS_Id) = Xmlns_Sequence then
               Add_Namespace
                 (Parser, Parser.Current_Node,
                  Attr_Name_Id, Value_Start, Value_End);
               Add_Attr := Parser.Feature_Namespace_Prefixes;

            --  Is this the declaration of the default namesapce (xmlns="uri")

            elsif Attr_NS_Id = Null_Token
              and then Value (Parser, Attr_Name_Id, Attr_Name_Id) =
              Xmlns_Sequence
            then
               Add_Namespace
                 (Parser, Parser.Current_Node,
                  Null_Token, Value_Start, Value_End);
               Add_Attr := Parser.Feature_Namespace_Prefixes;

            else
               --  All attributes must be defined (including xml:lang, that

               --  requires additional testing afterwards

               if Parser.Feature_Validation then
                  declare
                     Atts : constant Attributes_Ptr := Get
                       (Parser.Default_Atts,
                        Value (Parser, Elem_Name_Id, Elem_Name_Id));
                     Index : Natural;
                     Att_Type : Attribute_Type;
                  begin
                     if Atts = null then
                        Fatal_Error
                          (Parser, "[VC] No attribute defined for element "
                           & Value (Parser, Elem_Name_Id, Elem_Name_Id));
                     end if;

                     Index := Get_Index
                       (Atts.all,
                        Qname_From_Name (Parser, Attr_NS_Id, Attr_Name_Id));
                     if Index = -1 then
                        Fatal_Error
                          (Parser, "[VC] Attribute not declared in DTD: "
                           & Qname_From_Name
                           (Parser, Attr_NS_Id, Attr_Name_Id));
                     end if;

                     Att_Type := Get_Type (Atts.all, Index);
                     if (Att_Type = Idrefs or else Att_Type = Nmtokens)
                       and then Value_Start.First > Value_End.Last
                     then
                        Fatal_Error
                          (Parser,
                           "[VC 3.3.1] requires at least one name in IDREFS"
                           & " and NMTOKENS", Value_Start);
                     end if;
                  end;
               end if;

               if Value (Parser, Attr_NS_Id, Attr_NS_Id) = Xml_Sequence
                 and then
                 Value (Parser, Attr_Name_Id, Attr_Name_Id) = Lang_Sequence
               then
                  Test_Valid_Lang
                    (Parser, Value (Parser, Value_Start, Value_End));
               end if;
            end if;

            --  Register the attribute

            if Add_Attr then
               Add_Attribute
                 (Attributes,
                  URI => Value (Parser, Attr_NS_Id, Attr_NS_Id),
                  Local_Name => Value (Parser, Attr_Name_Id, Attr_Name_Id),
                  Qname => Qname_From_Name (Parser, Attr_NS_Id, Attr_Name_Id),
                  Att_Type => Sax.Attributes.Cdata,
                  Content => null,
                  Value => Value (Parser, Value_Start, Value_End));
            end if;

            if Attr_NS_Id /= Null_Token then
               Reset_Buffer (Parser, Attr_NS_Id);
            else
               Reset_Buffer (Parser, Attr_Name_Id);
            end if;

            Next_Token (Input, Parser, Id);
            if Id.Typ = Space then
               Next_Token (Input, Parser, Id);
            elsif Id.Typ /= End_Of_Tag and then Id.Typ /= End_Of_Start_Tag then
               Fatal_Error
                 (Parser, "[3.1] Attributes must be separated by spaces", Id);
            end if;
         end loop;

         Attr := Get
           (Parser.Default_Atts,
            Qname_From_Name (Parser, Elem_NS_Id, Elem_Name_Id));

         --  Check that all #REQUIRED attributes are defined

         --  and that #FIXED attributes have the defined value

         if Parser.Feature_Validation and then Attr /= null then
            for J in 0 .. Get_Length (Attr.all) - 1 loop
               if Get_Default_Declaration (Attr.all, J) = Required then
                  Found := False;
                  for K in 0 .. Get_Length (Attributes) - 1 loop
                     if Get_Qname (Attributes, K)
                       = Get_Qname (Attr.all, J)
                     then
                        Found := True;
                        exit;
                     end if;
                  end loop;

                  if not Found then
                     Fatal_Error
                       (Parser, "[VC 3.3.2] Required attribute '"
                        & Get_Qname (Attr.all, J) & "' must be defined", Id);
                  end if;

               elsif Get_Default_Declaration (Attr.all, J) = Fixed then
                  for K in 0 .. Get_Length (Attributes) - 1 loop
                     if Get_Qname (Attributes, K)
                       = Get_Qname (Attr.all, J)
                     then
                        if Get_Value (Attributes, K)
                          /= Get_Value (Attr.all, J)
                        then
                           Fatal_Error
                             (Parser, "[VC 3.3.2] Fixed attribute '"
                              & Get_Qname (Attr.all, J) & "' must have the"
                              & " defined value", Id);
                        end if;
                        exit;
                     end if;
                  end loop;
               end if;
            end loop;
         end if;

         --  Add all the default attributes to the element

         --  We shouldn't add an attribute if it was overriden by the user


         if Attr /= null then
            for J in 0 .. Get_Length (Attr.all) - 1 loop
               --  ??? This could/should be more efficient.

               if Get_Default_Declaration (Attr.all, J) /=
                   Sax.Attributes.Implied
                 and then Get_Index (Attributes,
                                     Get_URI (Attr.all, J),
                                     Get_Local_Name (Attr.all, J)) = -1
               then
                  Add_Attribute (Attributes,
                                 Get_URI (Attr.all, J),
                                 Get_Local_Name (Attr.all, J),
                                 Get_Qname (Attr.all, J),
                                 Get_Type (Attr.all, J),
                                 Get_Content (Attr.all, J),
                                 Get_Value (Attr.all, J));
               end if;
            end loop;
         end if;

         Set_State (Parser, Default_State);
         Find_NS (Parser, Parser.Current_Node,  Elem_NS_Id, NS);
         Start_Element
           (Parser,
            Namespace_URI => NS.URI.all,
            Local_Name => Value (Parser, Elem_Name_Id, Elem_Name_Id),
            Qname => Qname_From_Name (Parser, Elem_NS_Id, Elem_Name_Id),
            Atts => Attributes);

         Clear (Attributes);

         if Id.Typ = End_Of_Start_Tag then
            End_Element (Elem_NS_Id, Elem_Name_Id);
         end if;

         if Elem_NS_Id /= Null_Token then
            Reset_Buffer (Parser, Elem_NS_Id);
         else
            Reset_Buffer (Parser, Elem_Name_Id);
         end if;

         if Id.Typ = End_Of_Input then
            Fatal_Error (Parser, "[WF] Unexpected end of stream");
         end if;
      end Parse_Start_Tag;

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

      -- Parse_Doctype_Contents --

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


      procedure Parse_Doctype_Contents is
         Start_Id : Natural;

         Num_Include : Natural := 0;
         --  Number of <![INCLUDE[ sections at the top of the external

         --  subset.


         Num_Ignore : Natural := 0;
         --  Number of <![IGNORE[ and <![INCLUDE[ sections, starting at the

         --  first ignore section.

      begin
         loop
            Next_Token_Skip_Spaces (Input, Parser, Id);
            Start_Id := Id.Input_Id;

            if Id.Typ = Ignore then
               Num_Ignore := Num_Ignore + 1;

            elsif Id.Typ = Include or else Id.Typ = Start_Conditional then
               if Num_Ignore > 0 then
                  Num_Ignore := Num_Ignore + 1;
               else
                  Num_Include := Num_Include + 1;
               end if;

            elsif Id.Typ = End_Conditional then
               if Num_Include + Num_Ignore = 0 then
                  Fatal_Error
                    (Parser,
                     "[2.4] Text may not contain the litteral ']]>'", Id);
               elsif Num_Ignore > 0 then
                  Num_Ignore := Num_Ignore - 1;
               else
                  Num_Include := Num_Include  - 1;
               end if;

            elsif Id.Typ = End_Of_Input then
               exit;

            elsif Num_Ignore = 0 then
               case Id.Typ is
                  when End_Of_Tag | Internal_DTD_End =>
                     exit;
                  when Entity_Def => Parse_Entity_Def (Id);
                  when Element_Def => Parse_Element_Def (Id);
                  when Notation => Parse_Notation_Def (Id);
                  when Attlist_Def => Parse_Attlist_Def (Id);
                  when Text | Name =>
                     Fatal_Error
                       (Parser,  "[WF] Unexpected character in the DTD");
                  when Comment =>
                     Comment (Parser, Value (Parser, Id, Id));
                     Reset_Buffer (Parser, Id);
                  when Start_Of_PI =>
                     Parse_PI (Id);
                  when others =>
                     Fatal_Error
                       (Parser, "[2.8] Element not allowed in the DTD", Id);
               end case;

            else
               Reset_Buffer (Parser, Id);
            end if;

            if Start_Id /= Id.Input_Id then
               Fatal_Error
                 (Parser, "[4.5] Entity values must be self-contained", Id);
            end if;
         end loop;

         if Num_Ignore + Num_Include /= 0 then
            Fatal_Error
              (Parser, "[3.4] Conditional section must be properly terminated",
               Id);
         end if;
      end Parse_Doctype_Contents;

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

      -- Parse_Doctype --

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


      procedure Parse_Doctype is
         Public_Start, Public_End : Token := Null_Token;
         System_Start, System_End : Token := Null_Token;
         Name_Id : Token;
      begin
         Set_State (Parser, DTD_State);

         Next_Token_Skip_Spaces (Input, Parser, Name_Id);
         if Name_Id.Typ /= Name then
            Fatal_Error (Parser, "[WF] Expecting name after <!DOCTYPE");
         end if;

         Next_Token_Skip_Spaces (Input, Parser, Id);
         Get_External (Id, System_Start, System_End, Public_Start, Public_End);
         if Id.Typ = Space then
            Next_Token (Input, Parser, Id);
         end if;
         Start_DTD
           (Parser,
            Name => Value (Parser, Name_Id, Name_Id),
            Public_Id => Value (Parser, Public_Start, Public_End),
            System_Id => Value (Parser, System_Start, System_End));

         if Parser.Feature_Validation then
            Parser.DTD_Name := new Byte_Sequence'
              (Value (Parser, Name_Id, Name_Id));
         end if;

         if Id.Typ = Internal_DTD_Start then
            Parse_Doctype_Contents;
            if Id.Typ /= Internal_DTD_End then
               Fatal_Error
                 (Parser, "[2.8] Expecting end of internal subset ']>'", Id);
            end if;
         elsif Id.Typ /= End_Of_Tag then
            Fatal_Error (Parser, "[WF] Expecting end of DTD");
         end if;

         --  Read the external subset if required. This needs to be read

         --  after the internal subset only, so that the latter gets

         --  priority (XML specifications 2.8)

         if System_End.Last >= System_Start.First then
            declare
               Loc : Locator_Impl;
               URI : constant Byte_Sequence := Resolve_URI
                 (Parser, Value (Parser, System_Start, System_End));
               In_External : constant Boolean := Parser.In_External_Entity;
               Last  : constant Unicode_Char := Parser.Last_Read;
               Input_F : File_Input;
            begin
               Copy (Loc, Parser.Locator.all);
               Set_Line_Number (Parser.Locator.all, 1);
               Set_Column_Number
                 (Parser.Locator.all, 1 + Prolog_Size (Input_F));
               Set_System_Id (Parser.Locator.all, URI);
               Set_Public_Id (Parser.Locator.all,
                              Value (Parser, System_Start, System_End));
               Reset_Buffer (Parser, Name_Id);

               Parser.In_External_Entity := True;
               Open (URI, Input_F);

               Syntactic_Parse (Parser, Input_F);
               Close (Input_F);
               Parser.In_External_Entity := In_External;
               Copy (Parser.Locator.all, Loc);
               Free (Loc);
               Parser.Last_Read := Last;
            exception
               when Name_Error =>
                  Error (Parser,
                         "External subset not found: " & URI, Id);
            end;
         else
            Reset_Buffer (Parser, Name_Id);
         end if;

         Parser.In_External_Entity := False;
         End_DTD (Parser);
         Set_State (Parser, Default_State);
      end Parse_Doctype;

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

      -- End_Element --

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


      procedure End_Element (NS_Id, Name_Id : Token) is
         NS : XML_NS;
      begin
         Find_NS (Parser, Parser.Current_Node, NS_Id, NS);
         End_Element
           (Parser,
            Namespace_URI => NS.URI.all,
            Local_Name => Parser.Current_Node.Name.all,
            Qname => Qname_From_Name (Parser, NS_Id, Name_Id));

         --  Tag must end in the same entity

         if Id.Input_Id /= Parser.Current_Node.Start_Id then
            Fatal_Error
              (Parser, "[4.5] Entity values must be self-contained", Id);
         end if;

         --  Close all the namespaces

         NS := Parser.Current_Node.Namespaces;
         while NS /= null loop
            End_Prefix_Mapping (Parser, NS.Prefix.all);
            NS := NS.Next;
         end loop;

         --  Move back to the parent node (after freeing the current node)

         Free (Parser.Current_Node);
      end End_Element;

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

      -- Parse_End_Tag --

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


      procedure Parse_End_Tag is
         Open_Id : constant Token := Id;
         NS_Id, Name_Id : Token := Null_Token;
      begin
         Set_State (Parser, Tag_State);

         Next_Token (Input, Parser, Id);
         Get_Name_NS (Id, NS_Id, Name_Id);
         if Id.Typ = Space then
            Next_Token (Input, Parser, Id);
         end if;

         if Id.Typ /= End_Of_Tag then
            Fatal_Error (Parser, "[3.1] Tags must end with a '>' symbol", Id);
         end if;

         --  Tag must end in the same entity

         if Id.Input_Id /= Parser.Current_Node.Start_Id then
            Fatal_Error
              (Parser, "[4.5] Entity values must be self-contained", Id);
         end if;

         if Parser.Current_Node = null
           or else
           Value (Parser, NS_Id, NS_Id) /= Parser.Current_Node.NS.all
           or else
           Value (Parser, Name_Id, Name_Id) /= Parser.Current_Node.Name.all
         then
            --  Well-Formedness Constraint: Element Type Match

            Fatal_Error
              (Parser,
               "[WF-Element Type Match] Name differ for closing tag",
               Open_Id);
         end if;

         End_Element (NS_Id, Name_Id);

         Set_State (Parser, Default_State);
         if NS_Id /= Null_Token then
            Reset_Buffer (Parser, NS_Id);
         else
            Reset_Buffer (Parser, Name_Id);
         end if;
      end Parse_End_Tag;

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

      -- Check_Version_Value --

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


      procedure Check_Version_Value is
         C : Unicode_Char;
         J : Natural;
         Value_Start, Value_End : Token;
      begin
         Next_Token_Skip_Spaces (Input, Parser, Id);
         if Id.Typ /= Equal then
            Fatal_Error (Parser, "Expecting '=' sign", Id);
         end if;

         Next_Token_Skip_Spaces (Input, Parser, Id);
         if Id.Typ /= Double_String_Delimiter
           and then Id.Typ /= Single_String_Delimiter
         then
            Fatal_Error (Parser, "[WF] Expecting version value", Id);
         end if;
         Get_String (Id, Attr_Value_State, Value_Start, Value_End);

         J := Value_Start.First;
         while J <= Value_End.Last loop
            C := Encoding.Read (Parser.Buffer, J);
            J := J + Encoding.Width (C);
            if not (C in Latin_Small_Letter_A .. Latin_Small_Letter_Z)
              and then
                 not (C in Latin_Capital_Letter_A .. Latin_Capital_Letter_Z)
              and then not (C in Digit_Zero .. Digit_Nine)
              and then C /= Low_Line
              and then C /= Period
              and then C /= Unicode.Names.Basic_Latin.Colon
              and then C /= Hyphen_Minus
            then
               Fatal_Error
                 (Parser, "[2.8] Illegal version number in <?xml?> processing"
                  & " instruction", Value_Start);
            end if;
         end loop;

         Next_Token (Input, Parser, Id);
         if Id.Typ = Space then
            Next_Token (Input, Parser, Id);
         elsif Id.Typ /= End_Of_PI then
            Fatal_Error (Parser, "values must be separated by spaces", Id);
         end if;
      end Check_Version_Value;

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

      -- Check_Encoding_Value --

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


      procedure Check_Encoding_Value is
         C : Unicode_Char;
         J : Natural;
         Value_Start, Value_End : Token;
      begin
         Next_Token_Skip_Spaces (Input, Parser, Id);
         if Id.Typ /= Equal then
            Fatal_Error (Parser, "Expecting '=' sign");
         end if;

         Next_Token_Skip_Spaces (Input, Parser, Id);
         if Id.Typ /= Double_String_Delimiter
           and then Id.Typ /= Single_String_Delimiter
         then
            Fatal_Error (Parser, "[WF] Expecting encoding value");
         end if;
         Get_String (Id, Attr_Value_State, Value_Start, Value_End);

         if Value_End.Last < Value_Start.First then
            Fatal_Error
              (Parser, "[4.3.3] Empty value for encoding not allowed");
         else
            C := Encoding.Read (Parser.Buffer, Value_Start.First);
            if not (C in Latin_Small_Letter_A .. Latin_Small_Letter_Z)
              and then not
                (C in Latin_Capital_Letter_A .. Latin_Capital_Letter_Z)
            then
               Fatal_Error
                 (Parser, "[4.3.3] Illegal character '"
                  & Encoding.Encode (C) & "' in encoding value", Value_Start);
            end if;

            J := Value_Start.First + Encoding.Width (C);
            while J <= Value_End.Last loop
               C := Encoding.Read (Parser.Buffer, J);
               J := J + Encoding.Width (C);
               if not (C in Latin_Small_Letter_A .. Latin_Small_Letter_Z)
                 and then not
                   (C in Latin_Capital_Letter_A .. Latin_Capital_Letter_Z)
                 and then not (C in Digit_Zero .. Digit_Nine)
                 and then C /= Period
                 and then C /= Low_Line
                 and then C /= Hyphen_Minus
               then
                  Fatal_Error
                    (Parser, "(4.3.3) Illegal character '"
                     & Encoding.Encode (C) & "' in encoding value",
                     Value_Start);
               end if;
            end loop;
         end if;

         --  Check we indeed have a following space


         Next_Token (Input, Parser, Id);
         if Id.Typ = Space then
            Next_Token (Input, Parser, Id);
         elsif Id.Typ /= End_Of_PI then
            Fatal_Error (Parser, "values must be separated by spaces", Id);
         end if;
      end Check_Encoding_Value;

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

      -- Check_Standalone_Value --

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


      procedure Check_Standalone_Value is
         Value_Start, Value_End : Token;
      begin
         Next_Token_Skip_Spaces (Input, Parser, Id);
         if Id.Typ /= Equal then
            Fatal_Error (Parser, "Expecting '=' sign");
         end if;

         Next_Token_Skip_Spaces (Input, Parser, Id);
         if Id.Typ /= Double_String_Delimiter
           and then Id.Typ /= Single_String_Delimiter
         then
            Fatal_Error
              (Parser, "Parameter to 'standalone' must be quoted", Id);
         end if;
         Get_String (Id, Attr_Value_State, Value_Start, Value_End);

         if Value (Parser, Value_Start, Value_End) /= Yes_Sequence
           and then Value (Parser, Value_Start, Value_End) /= No_Sequence
         then
            Fatal_Error
              (Parser,
               "[2.9 [32]] Invalid value for standalone parameter in <?xml?>",
               Value_Start);
         end if;

         Next_Token (Input, Parser, Id);
         if Id.Typ = Space then
            Next_Token (Input, Parser, Id);
         elsif Id.Typ /= End_Of_PI then
            Fatal_Error (Parser, "values must be separated by spaces", Id);
         end if;
      end Check_Standalone_Value;

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

      -- Parse_PI --

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


      procedure Parse_PI (Id : in out Token) is
         State : constant Parser_State := Get_State (Parser);
         Open_Id : constant Token := Id;
         Name_Id, Data_Start : Token;
         Data_End : Token := Null_Token;
      begin
         Set_State (Parser, PI_State);

         Next_Token (Input, Parser, Name_Id);
         if Name_Id.Typ /= Name then
            Fatal_Error
              (Parser,
               "[2.6] Processing Instruction must specify a target name",
               Name_Id);
         end if;

         Next_Token (Input, Parser, Id);
         if Id.Typ /= Space and then Id.Typ /= End_Of_PI then
            Fatal_Error (Parser, "Must have space betwee target and data");
         elsif Id.Typ = Space then
            Next_Token (Input, Parser, Id);
         end if;

         --  Special handling for <?xml?>

         if Value (Parser, Name_Id, Name_Id) = Xml_Sequence then

            if Open_Id.Line /= 1
              or else Open_Id.Column /= 1 + Prolog_Size (Input)
              or else (Parser.Inputs /= null
                       and then not Parser.Inputs.External)
            then
               Fatal_Error
                 (Parser,
                  "[2.8] <?xml?> instruction must be first in document",
                  Open_Id);
            end if;

            --  ??? No true for text declaratinos 4.3.1 (external parsed

            --  entities)

            Set_State (Parser, Tag_State);

            if Value (Parser, Id, Id) = Version_Sequence then
               Check_Version_Value;
            elsif not Parser.In_External_Entity then
               Fatal_Error
                 (Parser, "'version' must be the first argument to <?xml?>",
                  Id);
            end if;

            if Id.Typ = Name
              and then Value (Parser, Id, Id) = Encoding_Sequence
            then
               Check_Encoding_Value;
            elsif Parser.In_External_Entity then
               Fatal_Error
                 (Parser, "'encoding' must be specified for <?xml?> in"
                  & " external entities", Id);
            end if;

            if not Parser.In_External_Entity
              and then Id.Typ = Name
              and then Value (Parser, Id, Id) = Standalone_Sequence
            then
               Check_Standalone_Value;
            end if;

            if Id.Typ /= End_Of_PI then
               if Parser.In_External_Entity then
                  Fatal_Error
                    (Parser,
                     "Text declarations <?xml?> in external entity can not"
                     & " specify parameters other than 'version' and"
                     & " 'encoding'", Id);
               else
                  Fatal_Error
                    (Parser,
                     "<?xml..?> arguments can only be 'version', 'encoding' or"
                     & " 'standalone', in that order", Id);
               end if;
            end if;

         else
            --  (2.6)[17]: Name can not be 'xml' (case insensitive)

            declare
               C : Unicode_Char;
               J : Natural := Name_Id.First;
            begin
               C := Encoding.Read (Parser.Buffer, J);
               J := J + Encoding.Width (C);

               if C = Latin_Small_Letter_X
                 or else C = Latin_Capital_Letter_X
               then
                  C := Encoding.Read (Parser.Buffer, J);
                  J := J + Encoding.Width (C);

                  if C = Latin_Capital_Letter_M
                    or else C = Latin_Small_Letter_M
                  then
                     C := Encoding.Read (Parser.Buffer, J);
                     J := J + Encoding.Width (C);

                     if (C = Latin_Capital_Letter_L
                         or else C = Latin_Small_Letter_L)
                       and then J = Name_Id.Last + 1
                     then
                        Fatal_Error
                          (Parser,
                           "[2.6] '" & Value (Parser, Name_Id, Name_Id)
                           & "' is not a valid processing instruction target",
                           Name_Id);
                     end if;
                  end if;
               end if;
            end;

            Data_Start := Id;

            while Id.Typ /= End_Of_PI and then Id.Typ /= End_Of_Input loop
               Data_End := Id;
               Next_Token (Input, Parser, Id);
            end loop;

            if Id.Typ = End_Of_Input then
               Fatal_Error
                 (Parser, "[2.6] Processing instruction must end with '?>'",
                  Open_Id);
            end if;

            Processing_Instruction
              (Parser,
               Target => Value (Parser, Name_Id, Name_Id),
               Data   => Value (Parser, Data_Start, Data_End));
         end if;

         Set_State (Parser, State);
         Reset_Buffer (Parser, Name_Id);
      end Parse_PI;

   begin
      --  Initialize the parser with the first character of the stream.

      if Eof (Input) then
         return;
      end if;
      Next_Char (Input, Parser);

      if Parser.State.In_DTD then
         Parse_Doctype_Contents;
      end if;

      loop
         --  Unless in string, buffer should be empty at this point. Strings

         --  are special-cased just in case we are currently substituting

         --  entities while in a string.

         pragma Assert (Parser.State.Ignore_Special
                        or else Parser.Buffer_Length = 0);

         Next_Token (Input, Parser, Id);
         exit when Id.Typ = End_Of_Input;

         case Id.Typ is
            when Start_Of_PI =>
               Parse_PI (Id);

            when Cdata_Section =>
               if Parser.Current_Node = null then
                  Fatal_Error
                    (Parser, "[2.1] Non-white space found at top level", Id);
               end if;
               Start_Cdata (Parser);
               Characters (Parser, Value (Parser, Id, Id));
               End_Cdata (Parser);
               Reset_Buffer (Parser, Id);

            when Text | Name =>
               if Parser.Current_Node = null then
                  Fatal_Error
                    (Parser, "[2.1] Non-white space found at top level", Id);
               end if;
               Characters (Parser, Value (Parser, Id, Id));
               Reset_Buffer (Parser, Id);

            when Sax.Readers.Space =>
               Ignorable_Whitespace (Parser, Value (Parser, Id, Id));
               Reset_Buffer (Parser, Id);

            when Comment =>
               Comment (Parser, Value (Parser, Id, Id));
               Reset_Buffer (Parser, Id);

            when Start_Of_Tag =>
               Parse_Start_Tag;

            when Start_Of_End_Tag =>
               Parse_End_Tag;

            when Doctype_Start =>
               Parse_Doctype;

            when others =>
               Fatal_Error (Parser, "[WF] Currently ignored: " & Id.Typ'Img);
         end case;
      end loop;
   end Syntactic_Parse;

   ----------

   -- Free --

   ----------


   procedure Free (Parser : in out Reader'Class) is
      Arr : Entity_Table.Table_Array :=
        Convert_To_Array (Parser.Entities);
      Tmp : Element_Access;
   begin
      Close_Inputs (Parser);
      Free (Parser.Default_Namespaces);
      Free (Parser.Locator);
      Free (Parser.DTD_Name);

      --  Free all the entities that were declared in the DTD.

      --  ??? Probably not the most efficient, but we would need another

      --  ??? implementation of table for that.


      for J in Arr'Range loop
         Free (Arr (J).Value.Value);
      end loop;

      --  Free the nodes, in case there are still some open

      Tmp := Parser.Current_Node;
      while Tmp /= null loop
         Free (Tmp);
      end loop;
   end Free;

   -----------

   -- Parse --

   -----------


   procedure Parse
     (Parser : in out Reader;
      Input  : in out Input_Sources.Input_Source'Class) is
   begin
      Parser.Locator := new Locator_Impl;
      Set_Public_Id (Parser.Locator.all, Get_Public_Id (Input));
      Set_System_Id (Parser.Locator.all, Get_System_Id (Input));
      Set_Column_Number (Parser.Locator.all, 1 + Prolog_Size (Input));
      Set_Line_Number (Parser.Locator.all, 1);
      Parser.Current_Node := null;
      Parser.Num_Toplevel_Elements := 0;
      Parser.Previous_Char_Was_CR := False;
      Parser.Ignore_State_Special := False;
      Parser.In_External_Entity := False;
      Set_State (Parser, Default_State);

      Add_Namespace_No_Event
        (Parser, Xml_Sequence,
         Encodings.From_Utf32
         (To_Utf32 ("http://www.w3.org/XML/1998/namespace")));
      Add_Namespace_No_Event (Parser, Xmlns_Sequence, Xmlns_Sequence);
      Add_Namespace_No_Event (Parser, "", "");

      Set_Document_Locator (Reader'Class (Parser), Parser.Locator);

      Start_Document (Reader'Class (Parser));
      Syntactic_Parse (Parser, Input);

      --  Close all the namespaces

      declare
         NS : XML_NS := Parser.Default_Namespaces;
      begin
         while NS /= null loop
            if NS.Prefix.all /= ""
              and then NS.Prefix.all /= Xmlns_Sequence
            then
               End_Prefix_Mapping (Reader'Class (Parser), NS.Prefix.all);
            end if;
            NS := NS.Next;
         end loop;
      end;

      --  All the nodes must have been closed at the end of the document

      if Parser.Current_Node /= null then
         Fatal_Error
           (Parser, "[2.1] Node <" & Parser.Current_Node.Name.all
            & "> is not closed");
      end if;

      if Parser.Num_Toplevel_Elements = 0 then
         Fatal_Error (Parser, "[2.1] No root element specified");
      end if;

      End_Document (Reader'Class (Parser));

      Free (Parser);

   exception
      when others =>
         Free (Parser);
         raise;
   end Parse;

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

   -- Entity_Img --

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


   function Entity_Img (A : Entity_Entry) return String is
   begin
      if A.Value /= null then
         return A.Value.all;
      else
         return "<null>";
      end if;
   end Entity_Img;

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

   -- Attributes_Img --

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


   function Attributes_Img (A : Attributes_Ptr) return String is
   begin
      return "<???>";
   end Attributes_Img;

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

   -- Get_Feature --

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


   function Get_Feature (Parser : Reader; Name : String) return Boolean is
   begin
      if Name = Namespace_Feature then
         return Parser.Feature_Namespace;

      elsif Name = Namespace_Prefixes_Feature then
         return Parser.Feature_Namespace_Prefixes;

      elsif Name = External_General_Entities_Feature then
         return Parser.Feature_External_General_Entities;

      elsif Name = External_Parameter_Entities_Feature then
         return Parser.Feature_External_Parameter_Entities;

      elsif Name = Validation_Feature then
         return Parser.Feature_Validation;

      elsif Name = Parameter_Entities_Feature then
         return False;  --  ??? Unsupported for now

      end if;

      return False;
   end Get_Feature;

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

   -- Set_Feature --

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


   procedure Set_Feature
     (Parser : in out Reader; Name : String; Value : Boolean) is
   begin
      if Name = Namespace_Feature then
         Parser.Feature_Namespace := Value;

      elsif Name = Namespace_Prefixes_Feature then
         Parser.Feature_Namespace_Prefixes := Value;

      elsif Name = External_General_Entities_Feature then
         Parser.Feature_External_General_Entities := Value;

      elsif Name = External_Parameter_Entities_Feature then
         Parser.Feature_External_Parameter_Entities := Value;

      elsif Name = Validation_Feature then
         Parser.Feature_Validation := Value;
      end if;
   end Set_Feature;

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

   -- Warning --

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


   procedure Warning
     (Handler : in out Reader; Except : Sax_Parse_Exception'Class) is
   begin
      null;
   end Warning;

   -----------

   -- Error --

   -----------


   procedure Error
     (Handler : in out Reader; Except : Sax_Parse_Exception'Class) is
   begin
      null;
   end Error;

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

   -- Fatal_Error --

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


   procedure Fatal_Error
     (Handler : in out Reader; Except : Sax_Parse_Exception'Class) is
   begin
      Raise_Exception
        (XML_Fatal_Error'Identity,
         Get_Message (Except));
   end Fatal_Error;

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

   -- Set_Document_Locator --

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


   procedure Set_Document_Locator
     (Handler : in out Reader; Loc : access Sax.Locators.Locator'Class) is
   begin
      null;
   end Set_Document_Locator;

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

   -- Start_Document --

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


   procedure Start_Document (Handler : in out Reader) is
   begin
      null;
   end Start_Document;

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

   -- End_Document --

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


   procedure End_Document (Handler : in out Reader) is
   begin
      null;
   end End_Document;

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

   -- Start_Prefix_Mapping --

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


   procedure Start_Prefix_Mapping
     (Handler : in out Reader;
      Prefix  : Unicode.CES.Byte_Sequence;
      URI     : Unicode.CES.Byte_Sequence) is
   begin
      null;
   end Start_Prefix_Mapping;

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

   -- End_Prefix_Mapping --

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


   procedure End_Prefix_Mapping
     (Handler : in out Reader; Prefix : Unicode.CES.Byte_Sequence) is
   begin
      null;
   end End_Prefix_Mapping;

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

   -- Start_Element --

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


   procedure Start_Element
     (Handler       : in out 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
      null;
   end Start_Element;

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

   -- End_Element --

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


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

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

   -- Characters --

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


   procedure Characters
     (Handler : in out Reader;
      Ch      : Unicode.CES.Byte_Sequence) is
   begin
      null;
   end Characters;

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

   -- Ignorable_Whitespace --

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


   procedure Ignorable_Whitespace
     (Handler : in out Reader; Ch : Unicode.CES.Byte_Sequence) is
   begin
      null;
   end Ignorable_Whitespace;

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

   -- Processing_Instruction --

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


   procedure Processing_Instruction
     (Handler : in out Reader;
      Target  : Unicode.CES.Byte_Sequence;
      Data    : Unicode.CES.Byte_Sequence) is
   begin
      null;
   end Processing_Instruction;

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

   -- Skipped_Entity --

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


   procedure Skipped_Entity
     (Handler : in out Reader; Name : Unicode.CES.Byte_Sequence) is
   begin
      null;
   end Skipped_Entity;

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

   -- Comment --

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


   procedure Comment
     (Handler : in out Reader;
      Ch      : Unicode.CES.Byte_Sequence) is
   begin
      null;
   end Comment;

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

   -- Start_Cdata --

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


   procedure Start_Cdata (Handler : in out Reader) is
   begin
      null;
   end Start_Cdata;

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

   -- End_Cdata --

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


   procedure End_Cdata (Handler : in out Reader) is
   begin
      null;
   end End_Cdata;

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

   -- Start_Entity --

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


   procedure Start_Entity
     (Handler : in out Reader;
      Name    : Unicode.CES.Byte_Sequence) is
   begin
      null;
   end Start_Entity;

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

   -- End_Entity --

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


   procedure End_Entity
     (Handler : in out Reader;
      Name    : Unicode.CES.Byte_Sequence) is
   begin
      null;
   end End_Entity;

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

   -- Start_DTD --

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


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

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

   -- End_DTD --

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


   procedure End_DTD (Handler : in out Reader) is
   begin
      null;
   end End_DTD;

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

   -- Internal_Entity_Decl --

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


   procedure Internal_Entity_Decl
     (Handler : in out Reader;
      Name    : Unicode.CES.Byte_Sequence;
      Value   : Unicode.CES.Byte_Sequence) is
   begin
      null;
   end Internal_Entity_Decl;

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

   -- External_Entity_Decl --

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


   procedure External_Entity_Decl
     (Handler   : in out Reader;
      Name      : Unicode.CES.Byte_Sequence;
      Public_Id : Unicode.CES.Byte_Sequence;
      System_Id : Unicode.CES.Byte_Sequence) is
   begin
      null;
   end External_Entity_Decl;

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

   -- Unparsed_Entity_Decl --

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


   procedure Unparsed_Entity_Decl
     (Handler       : in out Reader;
      Name          : Unicode.CES.Byte_Sequence;
      System_Id     : Unicode.CES.Byte_Sequence;
      Notation_Name : Unicode.CES.Byte_Sequence) is
   begin
      null;
   end Unparsed_Entity_Decl;

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

   -- Element_Decl --

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


   procedure Element_Decl
     (Handler : in out Reader;
      Name    : Unicode.CES.Byte_Sequence;
      Model   : Element_Model_Ptr) is
   begin
      null;
   end Element_Decl;

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

   -- Notation_Decl --

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


   procedure Notation_Decl
     (Handler       : in out Reader;
      Name          : Unicode.CES.Byte_Sequence;
      Public_Id     : Unicode.CES.Byte_Sequence;
      System_Id     : Unicode.CES.Byte_Sequence) is
   begin
      null;
   end Notation_Decl;

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

   -- Attribute_Decl --

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


   procedure Attribute_Decl
     (Handler : in out Reader;
      Ename   : Unicode.CES.Byte_Sequence;
      Aname   : Unicode.CES.Byte_Sequence;
      Typ     : Sax.Attributes.Attribute_Type;
      Content : Sax.Models.Element_Model_Ptr;
      Value_Default : Sax.Attributes.Default_Declaration;
      Value   : Unicode.CES.Byte_Sequence) is
   begin
      null;
   end Attribute_Decl;
end Sax.Readers;