File : dom-core-documents.adb
-----------------------------------------------------------------------
-- XML/Ada - An XML suite for Ada95 --
-- --
-- Copyright (C) 2001 --
-- ACT-Europe --
-- Author: Emmanuel Briot --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
-- License as published by the Free Software Foundation; either --
-- version 2 of the License, or (at your option) any later version. --
-- --
-- This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public --
-- License along with this library; if not, write to the --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- this unit, or you link this unit with other files to produce an --
-- executable, this unit does not by itself cause the resulting --
-- executable to be covered by the GNU General Public License. This --
-- exception does not however invalidate any other reasons why the --
-- executable file might be covered by the GNU Public License. --
-----------------------------------------------------------------------
with DOM.Core.Nodes; use DOM.Core.Nodes;
with DOM.Core.Elements; use DOM.Core.Elements;
with Unicode; use Unicode;
with Sax.Encodings; use Sax.Encodings;
with Unicode.Names.Basic_Latin; use Unicode.Names.Basic_Latin;
package body DOM.Core.Documents is
--------------
-- Doc_Type --
--------------
function Doc_Type (Doc : Document) return Document_Type is
begin
return Doc.Doc_Type;
end Doc_Type;
--------------------
-- Implementation --
--------------------
function Implementation (Doc : Document) return DOM_Implementation is
begin
return Doc.Implementation;
end Implementation;
-----------------
-- Get_Element --
-----------------
function Get_Element (Doc : Document) return Element is
Child : Node := First_Child (Doc);
begin
while Child /= null loop
if Child.Node_Type = Element_Node then
return Child;
end if;
Child := Next_Sibling (Child);
end loop;
return null;
end Get_Element;
--------------------
-- Create_Element --
--------------------
function Create_Element (Doc : Document; Tag_Name : DOM_String)
return Element is
begin
-- ??? Test for Invalid_Character_Err
-- ??? Must convert Tag_Name to uppercase for HTML documents
return new Node_Record'
(Node_Type => Element_Node,
Parent => null,
Prefix => null,
Local_Name => new DOM_String' (Tag_Name),
Namespace => null,
Children => Null_List,
Attributes => Null_Node_Map);
end Create_Element;
-----------------------
-- Create_Element_NS --
-----------------------
function Create_Element_NS
(Doc : Document;
Namespace_URI : DOM_String;
Qualified_Name : DOM_String) return Element
is
Colon_Pos : Integer := Qualified_Name'First;
C : Unicode_Char;
Prefix : DOM_String_Access;
Local : DOM_String_Access;
begin
-- ??? Test for Invalid_Character_Err
-- ??? Must convert Tag_Name to uppercase for HTML documents
-- ??? Test for Namespace_Err
while Colon_Pos <= Qualified_Name'Last loop
C := Encoding.Read (Qualified_Name, Colon_Pos);
exit when C = Colon;
Colon_Pos := Colon_Pos + Encoding.Width (C);
end loop;
if Colon_Pos <= Qualified_Name'Last then
Prefix := new DOM_String' (Qualified_Name
(Qualified_Name'First .. Colon_Pos - 1));
Local := new DOM_String' (Qualified_Name
(Colon_Pos + Encoding.Width (Colon) .. Qualified_Name'Last));
else
Local := new DOM_String' (Qualified_Name);
end if;
return new Node_Record'
(Node_Type => Element_Node,
Parent => null,
Prefix => Prefix,
Local_Name => Local,
Namespace => new DOM_String' (Namespace_URI),
Children => Null_List,
Attributes => Null_Node_Map);
end Create_Element_NS;
------------------------------
-- Create_Document_Fragment --
------------------------------
function Create_Document_Fragment (Doc : Document) return Document_Fragment
is
begin
return new Node_Record'
(Node_Type => Document_Fragment_Node,
Parent => null,
Doc_Frag_Children => Null_List);
end Create_Document_Fragment;
----------------------
-- Create_Text_Node --
----------------------
function Create_Text_Node (Doc : Document; Data : DOM_String)
return Text is
begin
return new Node_Record'
(Node_Type => Text_Node,
Parent => null,
Text => new DOM_String' (Data));
end Create_Text_Node;
--------------------
-- Create_Comment --
--------------------
function Create_Comment (Doc : Document; Data : DOM_String)
return Comment is
begin
return new Node_Record'
(Node_Type => Comment_Node,
Parent => null,
Comment => new DOM_String' (Data));
end Create_Comment;
--------------------------
-- Create_Cdata_Section --
--------------------------
function Create_Cdata_Section (Doc : Document; Data : DOM_String)
return Cdata_Section is
begin
-- ??? Must raise Not_Supported_Err for HTML documents
return new Node_Record'
(Node_Type => Cdata_Section_Node,
Parent => null,
Cdata => new DOM_String' (Data));
end Create_Cdata_Section;
-----------------------------------
-- Create_Processing_Instruction --
-----------------------------------
function Create_Processing_Instruction
(Doc : Document; Target : DOM_String; Data : DOM_String)
return Processing_Instruction is
begin
-- ??? Test for Invalid_Character_Err
-- ??? Must raise Not_Supported_Err for HTML documents
return new Node_Record'
(Node_Type => Processing_Instruction_Node,
Parent => null,
Target => new DOM_String' (Target),
Pi_Data => new DOM_String' (Data));
end Create_Processing_Instruction;
----------------------
-- Create_Attribute --
----------------------
function Create_Attribute (Doc : Document; Name : DOM_String)
return Attr is
begin
-- ??? Test for Invalid_Character_Err
return new Node_Record'
(Node_Type => Attribute_Node,
Parent => null,
Specified => False,
Attr_Prefix => null,
Attr_Local_Name => new DOM_String' (Name),
Attr_Value => null,
Attr_Namespace => null);
end Create_Attribute;
-------------------------
-- Create_Attribute_NS --
-------------------------
function Create_Attribute_NS
(Doc : Document;
Namespace_URI : DOM_String;
Qualified_Name : DOM_String) return Attr
is
Colon_Pos : Natural := Qualified_Name'First;
C : Unicode_Char;
Prefix : DOM_String_Access;
Local : DOM_String_Access;
begin
-- ??? Test for Invalid_Character_Err
-- ??? Must convert Tag_Name to uppercase for HTML documents
-- ??? Test for Namespace_Err
while Colon_Pos <= Qualified_Name'Last loop
C := Encoding.Read (Qualified_Name, Colon_Pos);
exit when C = Colon;
Colon_Pos := Colon_Pos + Encoding.Width (C);
end loop;
if Colon_Pos <= Qualified_Name'Last then
Prefix := new DOM_String' (Qualified_Name
(Qualified_Name'First .. Colon_Pos - 1));
Local := new DOM_String' (Qualified_Name
(Colon_Pos + Encoding.Width (Colon) .. Qualified_Name'Last));
else
Local := new DOM_String' (Qualified_Name);
end if;
return new Node_Record'
(Node_Type => Attribute_Node,
Parent => null,
Specified => False,
Attr_Prefix => Prefix,
Attr_Local_Name => Local,
Attr_Value => null,
Attr_Namespace => new DOM_String' (Namespace_URI));
end Create_Attribute_NS;
-----------------------------
-- Create_Entity_Reference --
-----------------------------
function Create_Entity_Reference (Doc : Document; Name : DOM_String)
return Entity_Reference is
begin
-- ??? Test for Invalid_Character_Err
-- ??? Must raise Not_Supported_Err for HTML documents
-- ??? Must test if entity is already known
return new Node_Record'
(Node_Type => Entity_Reference_Node,
Parent => null,
Entity_Reference_Name => new DOM_String' (Name));
end Create_Entity_Reference;
------------------------------
-- Get_Elements_By_Tag_Name --
------------------------------
function Get_Elements_By_Tag_Name
(Doc : Document; Tag_Name : DOM_String := "*") return Node_List is
begin
return DOM.Core.Elements.Get_Elements_By_Tag_Name
(Get_Element (Doc), Tag_Name);
end Get_Elements_By_Tag_Name;
---------------------------------
-- Get_Elements_By_Tag_Name_NS --
---------------------------------
function Get_Elements_By_Tag_Name_NS
(Doc : Document;
Namespace_URI : DOM_String := "*";
Local_Name : DOM_String := "*") return Node_List is
begin
return DOM.Core.Elements.Get_Elements_By_Tag_Name_NS
(Get_Element (Doc), Namespace_URI, Local_Name);
end Get_Elements_By_Tag_Name_NS;
-----------------
-- Import_Node --
-----------------
function Import_Node (Doc : Document; Import_Node : Node; Deep : Boolean)
return Node
is
N : Node := Clone_Node (Import_Node, Deep);
begin
pragma Assert (False); -- ??? Unimplemented
case N.Node_Type is
when Element_Node =>
-- ??? Shouldn't import defaulted attribute nodes
-- ??? Should assign default attributes from Doc
null;
when Attribute_Node => null;
when Text_Node | Cdata_Section_Node | Comment_Node => null;
when Entity_Reference_Node => null;
when Entity_Node => null;
when Processing_Instruction_Node => null;
when Document_Node => null;
when Document_Type_Node => null;
when Document_Fragment_Node => null;
when Notation_Node => null;
end case;
return N;
end Import_Node;
-----------------------
-- Get_Element_By_Id --
-----------------------
function Get_Element_By_Id
(Doc : Document; Element_Id : DOM_String) return Node is
begin
-- ??? Unimplemented
return null;
end Get_Element_By_Id;
end DOM.Core.Documents;