-----------------------------------------------------------------------
--                XML/Ada - An XML suite for Ada95                   --
--                                                                   --
--                       Copyright (C) 2001                          --
--                            ACT-Europe                             --
--                       Author: Emmanuel Briot                      --
--                                                                   --
-- This library is free software; you can redistribute it and/or     --
-- modify it under the terms of the GNU General Public               --
-- License as published by the Free Software Foundation; either      --
-- version 2 of the License, or (at your option) any later version.  --
--                                                                   --
-- This library is distributed in the hope that it will be useful,   --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
-- General Public License for more details.                          --
--                                                                   --
-- You should have received a copy of the GNU General Public         --
-- License along with this library; if not, write to the             --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
-- Boston, MA 02111-1307, USA.                                       --
--                                                                   --
-- As a special exception, if other files instantiate generics from  --
-- this unit, or you link this unit with other files to produce an   --
-- executable, this  unit  does not  by itself cause  the resulting  --
-- executable to be covered by the GNU General Public License. This  --
-- exception does not however invalidate any other reasons why the   --
-- executable file  might be covered by the  GNU Public License.     --
-----------------------------------------------------------------------

with Unicode;                   use Unicode;
with Unicode.CES;               use Unicode.CES;
with Unicode.Names.Basic_Latin; use Unicode.Names.Basic_Latin;
with Sax.Encodings;             use Sax.Encodings;
with Unchecked_Deallocation;
with Ada.Text_IO;               use Ada.Text_IO;

package body DOM.Core.Nodes is

   procedure Print_String (Str : DOM_String);
   --  Print a string on standard output, in XML.
   --  If Normalize is True, then adjoining spaces will be concatenated into
   --  one single space character, except for leading and trailing spaces
   --  which are discarded.

   function Clone_List (List : Node_List; Deep : Boolean) return Node_List;
   --  Return a clone of List. If Deep is True, then each item in the list
   --  is also cloned

   procedure Free (List : in out Node_List; Deep : Boolean);
   --  Free the list, and, if Deep is True, all its children

   function Child_Is_Valid (Parent : Node; Child : Node) return Boolean;
   --  Return True if Child can be added to Parent

   procedure Sort (Map : in out Named_Node_Map);
   --  Sort alphabetically the contents of Map (this is based on the value
   --  of Node_Name).

   --------------------
   -- Child_Is_Valid --
   --------------------

   function Child_Is_Valid (Parent : Node; Child : Node) return Boolean is
   begin
      case Parent.Node_Type is
         when Attribute_Node =>
            return Child.Node_Type = Text_Node
              or else Child.Node_Type = Entity_Reference_Node;

         when Text_Node | Cdata_Section_Node | Processing_Instruction_Node
           | Comment_Node | Document_Type_Node | Notation_Node =>
            return False;

         when Entity_Reference_Node | Entity_Node | Element_Node
           | Document_Fragment_Node =>
            return Child.Node_Type = Element_Node
              or else Child.Node_Type = Processing_Instruction_Node
              or else Child.Node_Type = Comment_Node
              or else Child.Node_Type = Text_Node
              or else Child.Node_Type = Cdata_Section_Node
              or else Child.Node_Type = Entity_Reference_Node;

         when Document_Node =>
            --  ??? Should check there is one single Element_Node
            return Child.Node_Type = Processing_Instruction_Node
              or else Child.Node_Type = Comment_Node
              or else Child.Node_Type = Document_Type_Node
              or else Child.Node_Type = Element_Node;
      end case;
   end Child_Is_Valid;

   ---------------
   -- Node_Name --
   ---------------

   function Node_Name (N : Node) return DOM_String is
   begin
      case N.Node_Type is
         when Element_Node =>
            pragma Assert (N.Local_Name /= null);
            if N.Prefix = null then
               return N.Local_Name.all;
            else
               return N.Prefix.all
                 & Encoding.Encode (Colon) & N.Local_Name.all;
            end if;

         when Attribute_Node =>
            pragma Assert (N.Attr_Local_Name /= null);
            if N.Attr_Prefix = null then
               return N.Attr_Local_Name.all;
            else
               return N.Attr_Prefix.all
                 & Encoding.Encode (Colon) & N.Attr_Local_Name.all;
            end if;

         when Text_Node =>
            --  ??? Should this return an encoded string instead ?
            return "#text";

         when Cdata_Section_Node =>
            return "#cdata-section";

         when Entity_Reference_Node =>
            pragma Assert (N.Entity_Reference_Name /= null);
            return N.Entity_Reference_Name.all;

         when Entity_Node =>
            pragma Assert (N.Entity_Name /= null);
            return N.Entity_Name.all;

         when Processing_Instruction_Node =>
            pragma Assert (N.Target /= null);
            return N.Target.all;

         when Comment_Node =>
            return "#comment";

         when Document_Node =>
            return "#document";

         when Document_Type_Node =>
            pragma Assert (N.Document_Type_Name /= null);
            return N.Document_Type_Name.all;

         when Document_Fragment_Node =>
            return "document-fragment";

         when Notation_Node =>
            pragma Assert (N.Public_ID /= null);
            return N.Public_ID.all;
      end case;
   end Node_Name;

   ----------------
   -- Node_Value --
   ----------------

   function Node_Value (N : Node) return DOM_String is
   begin
      case N.Node_Type is
         when Attribute_Node =>
            pragma Assert (N.Attr_Value /= null);
            return N.Attr_Value.all;

         when Text_Node =>
            pragma Assert (N.Text /= null);
            return N.Text.all;

         when Cdata_Section_Node =>
            pragma Assert (N.Cdata /= null);
            return N.Cdata.all;

         when Processing_Instruction_Node =>
            pragma Assert (N.Pi_Data /= null);
            return N.Pi_Data.all;

         when Comment_Node =>
            pragma Assert (N.Comment /= null);
            return N.Comment.all;

         when others =>
            return "";
      end case;
   end Node_Value;

   --------------------
   -- Set_Node_Value --
   --------------------

   procedure Set_Node_Value (N : Node; Value : DOM_String) is
   begin
      case N.Node_Type is
         when Attribute_Node =>
            --  ??? If Specified is False, we should make a copy and assign
            --  it to the owner element
            Free (N.Attr_Value);
            N.Attr_Value := new DOM_String' (Value);
            N.Specified := True;

         when Text_Node =>
            Free (N.Text);
            N.Text := new DOM_String' (Value);

         when Cdata_Section_Node =>
            Free (N.Cdata);
            N.Cdata := new DOM_String' (Value);

         when Processing_Instruction_Node =>
            Free (N.Pi_Data);
            N.Pi_Data := new DOM_String' (Value);

         when Comment_Node =>
            Free (N.Comment);
            N.Comment := new DOM_String' (Value);

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

   -----------------
   -- Child_Nodes --
   -----------------

   function Child_Nodes (N : Node) return Node_List is
   begin
      case N.Node_Type is
         when Element_Node => return N.Children;
         when Document_Node => return N.Doc_Children;
         when Document_Type_Node => return N.Doc_Type_Children;
         when Document_Fragment_Node => return N.Doc_Frag_Children;
         when others => return Null_List;
      end case;
   end Child_Nodes;

   -----------------
   -- First_Child --
   -----------------

   function First_Child (N : Node) return Node is
      List : Node_List := Child_Nodes (N);
   begin
      if List.Items = null then
         return null;
      else
         return List.Items (0);
      end if;
   end First_Child;

   ----------------
   -- Last_Child --
   ----------------

   function Last_Child (N : Node) return Node is
      List : Node_List := Child_Nodes (N);
   begin
      if List.Items = null then
         return null;
      else
         return List.Items (List.Last);
      end if;
   end Last_Child;

   ----------------------
   -- Previous_Sibling --
   ----------------------

   function Previous_Sibling (N : Node) return Node is
      List : Node_List;
   begin
      if N.Parent = null or else N.Node_Type = Attribute_Node then
         return null;
      end if;
      List := Child_Nodes (N.Parent);
      for J in 1 .. List.Last loop
         if List.Items (J) = N then
            return List.Items (J - 1);
         end if;
      end loop;
      return null;
   end Previous_Sibling;

   ------------------
   -- Next_Sibling --
   ------------------

   function Next_Sibling (N : Node) return Node is
      List : Node_List;
   begin
      if N.Parent = null or else N.Node_Type = Attribute_Node then
         return null;
      end if;
      List := Child_Nodes (N.Parent);
      for J in 0 .. List.Last - 1 loop
         if List.Items (J) = N then
            return List.Items (J + 1);
         end if;
      end loop;
      return null;
   end Next_Sibling;

   -----------------
   -- Parent_Node --
   -----------------

   function Parent_Node (N : Node) return Node is
   begin
      if N.Node_Type = Attribute_Node then
         return null;
      else
         return N.Parent;
      end if;
   end Parent_Node;

   ----------------
   -- Attributes --
   ----------------

   function Attributes (N : Node) return Named_Node_Map is
   begin
      case N.Node_Type is
         when Element_Node =>
            return N.Attributes;

         when others =>
            return Null_Node_Map;
      end case;
   end Attributes;

   --------------------
   -- Owner_Document --
   --------------------

   function Owner_Document (N : Node) return Node is
      P : Node := N;
   begin
      while P /= null and then P.Node_Type /= Document_Node loop
         P := P.Parent;
      end loop;
      return P;
   end Owner_Document;

   -------------------
   -- Namespace_URI --
   -------------------

   function Namespace_URI (N : Node) return DOM_String is
   begin
      case N.Node_Type is
         when Element_Node =>
            if N.Namespace /= null then
               return N.Namespace.all;
            else
               return "";
            end if;

         when Attribute_Node =>
            if N.Attr_Namespace /= null then
               return N.Attr_Namespace.all;
            else
               return "";
            end if;

         when others =>
            return "";
      end case;
   end Namespace_URI;

   ------------
   -- Prefix --
   ------------

   function Prefix (N : Node) return DOM_String is
   begin
      case N.Node_Type is
         when Element_Node =>
            if N.Prefix = null then
               return "";
            else
               return N.Prefix.all;
            end if;

         when Attribute_Node =>
            if N.Attr_Prefix = null then
               return "";
            else
               return N.Attr_Prefix.all;
            end if;

         when others =>
            return "";
      end case;
   end Prefix;

   ----------------
   -- Set_Prefix --
   ----------------

   procedure Set_Prefix (N : Node; Prefix : DOM_String) is
   begin
      --  ??? We're supposed to check that Prefix is valid, and raise
      --  Invalid_Character_Err otherwise
      case N.Node_Type is
         when Element_Node =>
            Free (N.Prefix);
            N.Prefix := new DOM_String' (Prefix);

         when Attribute_Node =>
            Free (N.Attr_Prefix);
            N.Attr_Prefix := new DOM_String' (Prefix);

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

   ----------------
   -- Local_Name --
   ----------------

   function Local_Name (N : Node) return DOM_String is
   begin
      case N.Node_Type is
         when Element_Node =>
            pragma Assert (N.Local_Name /= null);
            return N.Local_Name.all;

         when Attribute_Node =>
            pragma Assert (N.Attr_Local_Name /= null);
            return N.Attr_Local_Name.all;

         when others =>
            return "";
      end case;
   end Local_Name;

   -------------------
   -- Insert_Before --
   -------------------

   function Insert_Before
     (N         : Node;
      New_Child : Node;
      Ref_Child : Node := null) return Node
   is
      procedure Insert_Before (List : in out Node_List);
      --  Insert New_Child before Ref_Child in List

      procedure Insert_Before (List : in out Node_List) is
         Old : Node_Array_Access := List.Items;
      begin
         for J in 0 .. List.Last loop
            if List.Items (J) = Ref_Child then
               if List.Items'Last = List.Last then
                  List.Items := new Node_Array (0 .. List.Last + 5);
                  List.Items (0 .. List.Last) := Old.all;
                  Free (Old);
               end if;
               List.Items (0 .. List.Last + 1) :=
                 List.Items (0 .. J - 1) & New_Child
                 & List.Items (J .. List.Last);
               List.Last := List.Last + 1;
               return;
            end if;
         end loop;
      end Insert_Before;

      Tmp : Node;
   begin
      pragma Assert (Child_Is_Valid (N, New_Child));

      --  ??? Should check that New_Child was created from the same document
      --  (ie same DTD,...), or raise Wrong_Document_Err

      --  If New_Child is already in the tree, remove it first
      if New_Child.Parent /= null then
         Tmp := Remove_Child (New_Child.Parent, New_Child);
      end if;

      --  Ref_Child must be a child of N
      if Ref_Child /= null and then Ref_Child.Parent /= N then
         raise Not_Found_Err;
      end if;

      --  ???  if New_Child is Document_Fragment_Node, insert all its children

      if Ref_Child = null then
         case N.Node_Type is
            when Element_Node => Append (N.Children, New_Child);
            when Document_Node => Append (N.Doc_Children, New_Child);
            when Document_Type_Node =>
               Append (N.Doc_Type_Children, New_Child);
            when Document_Fragment_Node =>
               Append (N.Doc_Frag_Children, New_Child);
            when others => raise Hierarchy_Request_Err;
         end case;

      else
         case N.Node_Type is
            when Element_Node => Insert_Before (N.Children);
            when Document_Node => Insert_Before (N.Doc_Children);
            when Document_Type_Node => Insert_Before (N.Doc_Type_Children);
            when Document_Fragment_Node => Insert_Before (N.Doc_Frag_Children);
            when others => raise Hierarchy_Request_Err;
         end case;
      end if;
      New_Child.Parent := N;
      return New_Child;
   end Insert_Before;

   -------------------
   -- Replace_Child --
   -------------------

   function Replace_Child
     (N         : Node;
      New_Child : Node;
      Old_Child : Node) return Node
   is
      List : Node_List := Child_Nodes (N);
   begin
      pragma Assert (Child_Is_Valid (N, New_Child));
      --  ??? Case where New_Child is a document_fragment

      for J in 0 .. List.Last loop
         if List.Items (J) = Old_Child then
            List.Items (J) := New_Child;
            New_Child.Parent := N;
            return Old_Child;
         end if;
      end loop;
      return null;
   end Replace_Child;

   ------------------
   -- Remove_Child --
   ------------------

   function Remove_Child (N : Node; Old_Child : Node) return Node is
   begin
      case N.Node_Type is
         when Element_Node => Remove (N.Children, Old_Child);
         when Document_Node => Remove (N.Doc_Children, Old_Child);
         when Document_Type_Node => return null;
         when Document_Fragment_Node =>
            Remove (N.Doc_Frag_Children, Old_Child);
         when others => return null;
      end case;
      return Old_Child;
   end Remove_Child;

   ------------------
   -- Append_Child --
   ------------------

   function Append_Child
     (N         : Node;
      New_Child : Node) return Node is
   begin
      return Insert_Before (N, New_Child, null);
   end Append_Child;

   ---------------------
   -- Has_Child_Nodes --
   ---------------------

   function Has_Child_Nodes (N : Node) return Boolean is
   begin
      return First_Child (N) /= null;
   end Has_Child_Nodes;

   ----------------
   -- Clone_List --
   ----------------

   function Clone_List (List : Node_List; Deep : Boolean) return Node_List is
      L : Node_List := Null_List;
   begin
      if Deep then
         L := (Items => new Node_Array' (List.Items.all), Last  => List.Last);
         for J in 0 .. L.Last loop
            L.Items (J) := List.Items (J);
         end loop;
      end if;
      return L;
   end Clone_List;

   ----------------
   -- Clone_Node --
   ----------------

   function Clone_Node (N : Node; Deep : Boolean) return Node is
      Clone : Node;
   begin
      Clone := new Node_Record (N.Node_Type);
      Clone.Parent := null;

      case N.Node_Type is
         when Element_Node =>
            if N.Prefix /= null then
               Clone.Prefix := new DOM_String' (N.Prefix.all);
            end if;

            pragma Assert (N.Local_Name /= null);
            Clone.Local_Name := new DOM_String' (N.Local_Name.all);

            if N.Namespace /= null then
               Clone.Namespace := new DOM_String' (N.Namespace.all);
            end if;

            Clone.Children := Clone_List (N.Children, Deep);
            Clone.Attributes := Named_Node_Map
              (Clone_List (Node_List (N.Attributes), True));

         when Attribute_Node =>
            if N.Attr_Prefix /= null then
               Clone.Attr_Prefix := new DOM_String' (N.Attr_Prefix.all);
            end if;

            pragma Assert (N.Attr_Local_Name /= null);
            Clone.Attr_Local_Name :=
              new DOM_String' (N.Attr_Local_Name.all);

            if N.Attr_Value /= null then
               Clone.Attr_Value := new DOM_String' (N.Attr_Value.all);
            end if;

            if N.Attr_Namespace /= null then
               Clone.Attr_Namespace := new DOM_String' (N.Attr_Namespace.all);
            end if;

         when Text_Node =>
            if N.Text /= null then
               Clone.Text := new DOM_String' (N.Text.all);
            end if;

         when Cdata_Section_Node =>
            if N.Cdata /= null then
               Clone.Cdata := new DOM_String' (N.Cdata.all);
            end if;

         when Entity_Reference_Node =>
            pragma Assert (N.Entity_Reference_Name /= null);
            Clone.Entity_Reference_Name :=
              new DOM_String' (N.Entity_Reference_Name.all);

         when Entity_Node =>
            pragma Assert (N.Entity_Name /= null);
            Clone.Entity_Name := new DOM_String' (N.Entity_Name.all);

         when Processing_Instruction_Node =>
            Clone.Target := new DOM_String' (N.Target.all);
            Clone.Pi_Data := new DOM_String' (N.Pi_Data.all);

         when Comment_Node =>
            pragma Assert (N.Comment /= null);
            Clone.Comment := new DOM_String' (N.Comment.all);

         when Document_Node =>
            Clone.Doc_Children := Clone_List (N.Doc_Children, Deep);

         when Document_Type_Node =>
            Clone.Document_Type_Name :=
              new DOM_String' (N.Document_Type_Name.all);
            Clone.Doc_Type_Children := Clone_List (N.Doc_Type_Children, Deep);

         when Document_Fragment_Node =>
            Clone.Doc_Frag_Children := Clone_List (N.Doc_Frag_Children, Deep);

         when Notation_Node =>
            if N.Public_ID /= null then
               Clone.Public_ID := new DOM_String' (N.Public_ID.all);
            end if;

            if N.System_ID /= null then
               Clone.System_ID := new DOM_String' (N.System_ID.all);
            end if;
      end case;
      return Clone;
   end Clone_Node;

   ---------------
   -- Normalize --
   ---------------

   procedure Normalize (N : Node) is
      List  : Node_List := Child_Nodes (N);
      J     : Natural := 0;
      Old   : DOM_String_Access;
   begin
      while J < List.Last loop
         if List.Items (J).Node_Type = Text_Node
           and then List.Items (J + 1).Node_Type = Text_Node
         then
            Old := List.Items (J).Text;
            List.Items (J).Text := new DOM_String'
              (Old.all & List.Items (J + 1).Text.all);
            Free (List.Items (J + 1));
            Free (Old);
            List.Items (J + 1 .. List.Last - 1) :=
              List.Items (J + 2 .. List.Last);
            List.Last := List.Last - 1;
         else
            J := J + 1;
         end if;
      end loop;

      case N.Node_Type is
         when Element_Node => N.Children := List;
         when Document_Node => N.Doc_Children := List;
         when Document_Type_Node => N.Doc_Type_Children := List;
         when Document_Fragment_Node => N.Doc_Frag_Children := List;
         when others => null;
      end case;

      --  Normalize all the children
      J := 0;
      while J <= List.Last loop
         Normalize (List.Items (J));
         J := J + 1;
      end loop;
   end Normalize;

   --------------
   -- Supports --
   --------------

   function Supports
     (N : Node;
      Feature : DOM_String;
      Version : DOM_String) return Boolean is
   begin
      return False;
   end Supports;

   ----------
   -- Item --
   ----------

   function Item (List : Node_List; Index : Natural) return Node is
   begin
      if Index <= List.Last then
         return List.Items (Index);
      else
         return null;
      end if;
   end Item;

   ------------
   -- Length --
   ------------

   function Length (List : Node_List) return Natural is
   begin
      return List.Last + 1;
   end Length;

   --------------------
   -- Get_Named_Item --
   --------------------

   function Get_Named_Item
     (Map : Named_Node_Map; Name : DOM_String) return Node is
   begin
      for J in 0 .. Map.Last loop
         if Node_Name (Map.Items (J)) = Name then
            return Map.Items (J);
         end if;
      end loop;
      return null;
   end Get_Named_Item;

   --------------------
   -- Set_Named_Item --
   --------------------

   procedure Set_Named_Item
     (Map : in out Named_Node_Map; Arg : Node; Replaces : out Node) is
   begin
      Remove_Named_Item (Map, Node_Name (Arg), Replaces);
      Append (Node_List (Map), Arg);
   end Set_Named_Item;

   --------------------
   -- Set_Named_Item --
   --------------------

   procedure Set_Named_Item (Map : in out Named_Node_Map; Arg : Node) is
      Replaces : Node;
   begin
      Set_Named_Item (Map, Arg, Replaces);
   end Set_Named_Item;

   -----------------------
   -- Remove_Named_Item --
   -----------------------

   procedure Remove_Named_Item (Map : in out Named_Node_Map; N : Node) is
   begin
      for J in 0 .. Map.Last loop
         if Map.Items (J) = N then
            Map.Items (J .. Map.Last - 1) := Map.Items (J + 1 .. Map.Last);
            Map.Last := Map.Last - 1;
            return;
         end if;
      end loop;
   end Remove_Named_Item;

   -----------------------
   -- Remove_Named_Item --
   -----------------------

   procedure Remove_Named_Item
     (Map : in out Named_Node_Map; Name : DOM_String; Removed : out Node) is
   begin
      for J in 0 .. Map.Last loop
         if Node_Name (Map.Items (J)) = Name then
            Removed := Map.Items (J);
            Map.Items (J .. Map.Last - 1) := Map.Items (J + 1 .. Map.Last);
            Map.Last := Map.Last - 1;
            return;
         end if;
      end loop;
      Removed := null;
   end Remove_Named_Item;

   -----------------------
   -- Remove_Named_Item --
   -----------------------

   procedure Remove_Named_Item
     (Map : in out Named_Node_Map; Name : DOM_String)
   is
      Remove : Node;
   begin
      Remove_Named_Item (Map, Name, Remove);
   end Remove_Named_Item;

   ----------
   -- Item --
   ----------

   function Item
     (Map : Named_Node_Map; Index : Natural) return Node is
   begin
      return Item (Node_List (Map), Index);
   end Item;

   ------------
   -- Length --
   ------------

   function Length (Map : Named_Node_Map) return Natural is
   begin
      return Map.Last + 1;
   end Length;

   -----------------------
   -- Get_Named_Item_NS --
   -----------------------

   function Get_Named_Item_NS
     (Map           : Named_Node_Map;
      Namespace_URI : DOM_String;
      Local_Name    : DOM_String) return Node is
   begin
      for J in 0 .. Map.Last loop
         if DOM.Core.Nodes.Namespace_URI (Map.Items (J)) = Namespace_URI
           and then DOM.Core.Nodes.Local_Name (Map.Items (J)) = Local_Name
         then
            return Map.Items (J);
         end if;
      end loop;
      return null;
   end Get_Named_Item_NS;

   -----------------------
   -- Set_Named_Item_NS --
   -----------------------

   procedure Set_Named_Item_NS
     (Map : in out Named_Node_Map; Arg : Node; Replaces : out Node) is
   begin
      Remove_Named_Item_NS
        (Map, Namespace_URI (Arg), Local_Name (Arg), Replaces);
      Append (Node_List (Map), Arg);
   end Set_Named_Item_NS;

   -----------------------
   -- Set_Named_Item_NS --
   -----------------------

   procedure Set_Named_Item_NS
     (Map : in out Named_Node_Map; Arg : Node)
   is
      Replaces : Node;
   begin
      Set_Named_Item_NS (Map, Arg, Replaces);
   end Set_Named_Item_NS;

   --------------------------
   -- Remove_Named_Item_NS --
   --------------------------

   procedure Remove_Named_Item_NS
     (Map           : in out Named_Node_Map;
      Namespace_URI : DOM_String;
      Local_Name    : DOM_String;
      Removed       : out Node) is
   begin
      for J in 0 .. Map.Last loop
         if DOM.Core.Nodes.Namespace_URI (Map.Items (J)) = Namespace_URI
           and then DOM.Core.Nodes.Local_Name (Map.Items (J)) = Local_Name
         then
            Removed := Map.Items (J);
            Map.Items (J .. Map.Last - 1) := Map.Items (J + 1 .. Map.Last);
            Map.Last := Map.Last - 1;
            return;
         end if;
      end loop;
      Removed := null;
   end Remove_Named_Item_NS;

   --------------------------
   -- Remove_Named_Item_NS --
   --------------------------

   procedure Remove_Named_Item_NS
     (Map           : in out Named_Node_Map;
      Namespace_URI : DOM_String;
      Local_Name    : DOM_String)
   is
      Removed : Node;
   begin
      Remove_Named_Item_NS (Map, Namespace_URI, Local_Name, Removed);
   end Remove_Named_Item_NS;

   ----------
   -- Free --
   ----------

   procedure Free (List : in out Node_List; Deep : Boolean) is
   begin
      if Deep then
         for J in 0 .. List.Last loop
            Free (List.Items (J), Deep => True);
         end loop;
      end if;
      Free (List.Items);
   end Free;

   ----------
   -- Free --
   ----------

   procedure Free (N : in out Node; Deep : Boolean := True) is
      procedure Internal_Free is new Unchecked_Deallocation
        (Node_Record, Node);
   begin
      if N = null then
         return;
      end if;
      case N.Node_Type is
         when Element_Node =>
            Free (N.Prefix);
            Free (N.Local_Name);
            Free (N.Namespace);
            Free (Node_List (N.Attributes), Deep => True);
            Free (N.Children, Deep);

         when Attribute_Node =>
            Free (N.Attr_Prefix);
            Free (N.Attr_Local_Name);
            Free (N.Attr_Value);
            Free (N.Attr_Namespace);

         when Text_Node =>
            Free (N.Text);

         when Cdata_Section_Node =>
            Free (N.Cdata);

         when Entity_Reference_Node =>
            Free (N.Entity_Reference_Name);

         when Entity_Node =>
            Free (N.Entity_Name);

         when Processing_Instruction_Node =>
            Free (N.Target);
            Free (N.Pi_Data);

         when Comment_Node =>
            Free (N.Comment);

         when Document_Node =>
            Free (N.Doc_Children, Deep);

         when Document_Type_Node =>
            Free (N.Document_Type_Name);
            Free (N.Doc_Type_Children, Deep);

         when Document_Fragment_Node =>
            Free (N.Doc_Frag_Children, Deep);

         when Notation_Node =>
            Free (N.Public_ID);
            Free (N.System_ID);
      end case;
      Internal_Free (N);
   end Free;

   ----------
   -- Sort --
   ----------

   procedure Sort (Map : in out Named_Node_Map) is
      Arr : Node_Array (0 .. Map.Last + 1) := (others => null);
      Index : Natural;
   begin
      --  ??? The algorithm is not efficient, we use Insertion_Sort.
      for J in 0 .. Map.Last loop
         Index := 0;
         loop
            if Arr (Index) = null then
               Arr (Index) := Map.Items (J);
               exit;
            end if;

            if Node_Name (Map.Items (J)) <= Node_Name (Arr (Index)) then
               Arr (Index + 1 .. Arr'Last) := Arr (Index .. Arr'Last - 1);
               Arr (Index) := Map.Items (J);
               exit;
            end if;
            Index := Index + 1;
         end loop;
      end loop;
      for J in 0 .. Map.Last loop
         Map.Items (J) := Arr (J);
      end loop;
   end Sort;

   ------------------
   -- Print_String --
   ------------------

   procedure Print_String (Str : DOM_String) is
      J : Natural := Str'First;
      C : Unicode.Unicode_Char;
   begin
      while J <= Str'Last loop
         C := Encoding.Read (Str, J);
         case C is
            when Ampersand             => Put (Amp_DOM_Sequence);
            when Less_Than_Sign        => Put (Lt_DOM_Sequence);
            when Greater_Than_Sign     => Put (Gt_DOM_Sequence);
            when Quotation_Mark        => Put (Quot_DOM_Sequence);
               --  when Apostrophe            => Put ("&apos;");
            when Horizontal_Tabulation => Put (Tab_Sequence);
            when Line_Feed             => Put (Lf_Sequence);
            when Carriage_Return       => Put (Cr_Sequence);
            when others                => Put (Encoding.Encode (C));
         end case;
         J := J + Encoding.Width (C);
      end loop;
   end Print_String;

   -----------
   -- Print --
   -----------

   procedure Print
     (List           : Node_List;
      Print_Comments : Boolean := False;
      Print_XML_PI   : Boolean := False;
      With_URI       : Boolean := False) is
   begin
      for J in 0 .. List.Last loop
         Print (List.Items (J), Print_Comments, Print_XML_PI, With_URI);
      end loop;
   end Print;

   -----------
   -- Print --
   -----------

   procedure Print
     (N              : Node;
      Print_Comments : Boolean := False;
      Print_XML_PI   : Boolean := False;
      With_URI       : Boolean := False)
   is
      procedure Print_Name (N : Node);
      --  Print the name of the node.

      ----------------
      -- Print_Name --
      ----------------

      procedure Print_Name (N : Node) is
      begin
         if With_URI then
            Print_String (Namespace_URI (N) & Encoding.Encode (Colon)
                          & Local_Name (N));
         else
            Print_String (Node_Name (N));
         end if;
      end Print_Name;

   begin
      if N = null then
         return;
      end if;

      case N.Node_Type is
         when Element_Node =>
            --  ??? Should define a new constant in Sax.Encodings
            Put (Encoding.Encode (Less_Than_Sign));
            Print_Name (N);

            --  Sort the XML attributes as required for canonical XML
            Sort (N.Attributes);

            for J in 0 .. N.Attributes.Last loop
               Put (Encoding.Encode (Space));
               Print (N.Attributes.Items (J),
                      Print_Comments, Print_XML_PI, With_URI);
            end loop;
            Put (Encoding.Encode (Greater_Than_Sign));

            Print (N.Children, Print_Comments, Print_XML_PI, With_URI);

            Put (Encoding.Encode (Less_Than_Sign)
                 & Encoding.Encode (Slash));
            Print_Name (N);
            Put (Encoding.Encode (Greater_Than_Sign));

         when Attribute_Node =>
            Print_Name (N);
            Put (Encoding.Encode (Equals_Sign)
                 & Encoding.Encode (Quotation_Mark));
            Print_String (Node_Value (N));
            Put (Encoding.Encode (Quotation_Mark));

         when Processing_Instruction_Node =>
            if Print_XML_PI
              or else N.Target.all /= Xml_Sequence
            then
               Put (Encoding.Encode (Less_Than_Sign)
                    & Encoding.Encode (Question_Mark)
                    & N.Target.all);
               if N.Pi_Data'Length = 0
                 or else Encoding.Read
                 (N.Pi_Data.all, N.Pi_Data'First) /= Space
               then
                  Put (Encoding.Encode (Space));
               end if;
               Put (N.Pi_Data.all
                    & Encoding.Encode (Question_Mark)
                    & Encoding.Encode (Greater_Than_Sign));
            end if;

         when Comment_Node =>
            if Print_Comments then
               Put (Node_Value (N));
            end if;

         when Document_Node =>
            Print (N.Doc_Children,
                   Print_Comments, Print_XML_PI, With_URI);

         when Document_Fragment_Node =>
            Print (N.Doc_Frag_Children,
                   Print_Comments, Print_XML_PI, With_URI);

         when Document_Type_Node | Notation_Node =>
            null;

         when Text_Node =>
            Print_String (Node_Value (N));

         when others =>
            Put (Node_Value (N));
      end case;
   end Print;

end DOM.Core.Nodes;
