------------------------------------- ------------------------------------------- -- XML/Ada - An XML suite for Ada95 -- -- -- -- Copyright (C) 2001-2012, AdaCore -- -- -- -- This library is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 3, 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 MERCHAN- -- -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- -- -- -- -- -- -- -- -- -- You should have received a copy of the GNU General Public License and -- -- a copy of the GCC Runtime Library Exception along with this program; -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- ------------------------------------------------------------------------------ with DOM.Core.Nodes; use DOM.Core.Nodes; with DOM.Core.Elements; use DOM.Core.Elements; with Sax.Symbols; use Sax.Symbols; with Sax.Utils; use Sax.Utils; package body DOM.Core.Documents is use Nodes_Htable, Symbol_Table_Pointers; -------------- -- 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 => Doc, Parent_Is_Owner => True, Name => From_Qualified_Name (Doc, Doc.Symbols, Find (Doc.Symbols, Tag_Name)), 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 begin return new node_record' (Node_Type => element_node, Parent => Doc, Parent_Is_Owner => True, Name => From_Qualified_Name (Doc, Doc.Symbols, Find (Doc.Symbols, Qualified_Name), Find (Doc.Symbols, Namespace_URI)), Children => Null_List, Attributes => Null_Node_Map); end Create_Element_NS; ----------------------- -- Create_Element_NS -- ----------------------- function Create_Element_NS (Doc : document; Symbols : Sax.Utils.symbol_table; Namespace_URI : Sax.Symbols.symbol; Prefix : Sax.Symbols.symbol; Local_Name : Sax.Symbols.symbol) return element is Name : node_name_def; begin if Symbols = Doc.Symbols then Name := (Local_Name => Local_Name, Prefix => Prefix, Namespace => Namespace_URI); else Name := (Local_Name => Convert (Doc.Symbols, Local_Name), Prefix => Convert (Doc.Symbols, Prefix), Namespace => Convert (Doc.Symbols, Namespace_URI)); end if; return new node_record' (Node_Type => element_node, Parent => Doc, Parent_Is_Owner => True, Name => Name, 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 => Doc, Parent_Is_Owner => True, 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 => Doc, Parent_Is_Owner => True, Text => new dom_string'(Data)); end Create_Text_Node; function Create_Text_Node (Doc : document; Data : dom_string_access) return text is begin return new node_record' (Node_Type => text_node, Parent => Doc, Parent_Is_Owner => True, Text => 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 => Doc, Parent_Is_Owner => True, 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 => Doc, Parent_Is_Owner => True, 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 => Doc, Parent_Is_Owner => True, Target => Find (Symbol_Table_Pointers.Get (Doc.Symbols), Target), Pi_Data => Find (Symbol_Table_Pointers.Get (Doc.Symbols), 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 => Doc, Parent_Is_Owner => True, Specified => False, Owner_Element => Doc, Is_Id => False, Attr_Name => From_Qualified_Name (Doc, Doc.Symbols, Find (Doc.Symbols, Name)), Attr_Value => No_Symbol); end Create_Attribute; ------------------------- -- Create_Attribute_NS -- ------------------------- function Create_Attribute_NS (Doc : document; Namespace_URI : dom_string; Qualified_Name : dom_string) return attr is begin return new node_record' (Node_Type => attribute_node, Parent => Doc, Parent_Is_Owner => True, Specified => False, Owner_Element => Doc, Is_Id => False, Attr_Name => From_Qualified_Name (Doc, Doc.Symbols, Find (Doc.Symbols, Qualified_Name), Find (Doc.Symbols, Namespace_URI)), Attr_Value => No_Symbol); end Create_Attribute_NS; ------------------------- -- Create_Attribute_NS -- ------------------------- function Create_Attribute_NS (Doc : document; Symbols : symbol_table; Namespace_URI : Sax.Symbols.symbol; Prefix : Sax.Symbols.symbol; Local_Name : Sax.Symbols.symbol) return attr is Name : node_name_def; begin if Symbols = Doc.Symbols then Name := (Local_Name => Local_Name, Namespace => Namespace_URI, Prefix => Prefix); else Name := (Local_Name => Convert (Doc.Symbols, Local_Name), Namespace => Convert (Doc.Symbols, Namespace_URI), Prefix => Convert (Doc.Symbols, Prefix)); end if; return new node_record' (Node_Type => attribute_node, Parent => Doc, Parent_Is_Owner => True, Specified => False, Owner_Element => Doc, Is_Id => False, Attr_Name => Name, Attr_Value => No_Symbol); 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 => Doc, Parent_Is_Owner => True, Entity_Reference_Name => Find (Doc.Symbols, 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 pragma warnings (Off, Doc); N : constant 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 N : symbol; begin if Doc.Ids = null then return null; else N := Find (Doc.Symbols, Element_Id); return Get (Doc.Ids.all, N).N; end if; end Get_Element_By_Id; end DOM.Core.Documents;