1------------------------------------------------------------------------------ 2-- XML/Ada - An XML suite for Ada95 -- 3-- -- 4-- Copyright (C) 2001-2017, AdaCore -- 5-- -- 6-- This library is free software; you can redistribute it and/or modify it -- 7-- under terms of the GNU General Public License as published by the Free -- 8-- Software Foundation; either version 3, or (at your option) any later -- 9-- version. This library is distributed in the hope that it will be useful, -- 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12-- -- 13-- As a special exception under Section 7 of GPL version 3, you are granted -- 14-- additional permissions described in the GCC Runtime Library Exception, -- 15-- version 3.1, as published by the Free Software Foundation. -- 16-- -- 17-- You should have received a copy of the GNU General Public License and -- 18-- a copy of the GCC Runtime Library Exception along with this program; -- 19-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20-- <http://www.gnu.org/licenses/>. -- 21-- -- 22------------------------------------------------------------------------------ 23 24with DOM.Core.Attrs; use DOM.Core.Attrs; 25with DOM.Core.Documents; use DOM.Core.Documents; 26with Sax.Symbols; use Sax.Symbols; 27 28package body DOM.Core.Elements is 29 30 ------------------- 31 -- Get_Attribute -- 32 ------------------- 33 34 function Get_Attribute (Elem : Element; Name : DOM_String) 35 return DOM_String 36 is 37 Att : constant Attr := Get_Named_Item (Elem.Attributes, Name); 38 begin 39 if Att /= null then 40 return Node_Value (Att); 41 else 42 return ""; 43 end if; 44 end Get_Attribute; 45 46 ---------------------- 47 -- Get_Attribute_NS -- 48 ---------------------- 49 50 function Get_Attribute_NS 51 (Elem : Element; Namespace_URI : DOM_String; Local_Name : DOM_String) 52 return DOM_String 53 is 54 Att : constant Attr := Get_Named_Item_NS 55 (Elem.Attributes, Namespace_URI, Local_Name); 56 begin 57 if Att /= null then 58 return Node_Value (Att); 59 else 60 return ""; 61 end if; 62 end Get_Attribute_NS; 63 64 ------------------- 65 -- Set_Attribute -- 66 ------------------- 67 68 procedure Set_Attribute 69 (Elem : Element; Name : DOM_String; Value : DOM_String) 70 is 71 Att : constant Attr := Create_Attribute 72 (Owner_Document (Elem), Name); 73 begin 74 Set_Value (Att, Value); 75 Set_Named_Item_NS (Elem.Attributes, Att); 76 end Set_Attribute; 77 78 ---------------------- 79 -- Set_Attribute_NS -- 80 ---------------------- 81 82 procedure Set_Attribute_NS 83 (Elem : Element; 84 Namespace_URI : DOM_String; 85 Qualified_Name : DOM_String; 86 Value : DOM_String) 87 is 88 Att : constant Attr := Create_Attribute_NS 89 (Owner_Document (Elem), Namespace_URI, Qualified_Name); 90 begin 91 Set_Value (Att, Value); 92 Set_Named_Item_NS (Elem.Attributes, Att); 93 end Set_Attribute_NS; 94 95 ---------------------- 96 -- Remove_Attribute -- 97 ---------------------- 98 99 procedure Remove_Attribute (Elem : Element; Name : DOM_String) is 100 begin 101 Remove_Named_Item (Elem.Attributes, Name); 102 end Remove_Attribute; 103 104 ------------------------- 105 -- Remove_Attribute_NS -- 106 ------------------------- 107 108 procedure Remove_Attribute_NS 109 (Elem : Element; Namespace_URI : DOM_String; Local_Name : DOM_String) is 110 begin 111 Remove_Named_Item_NS (Elem.Attributes, Namespace_URI, Local_Name); 112 end Remove_Attribute_NS; 113 114 ------------------------ 115 -- Get_Attribute_Node -- 116 ------------------------ 117 118 function Get_Attribute_Node (Elem : Element; Name : DOM_String) 119 return Attr is 120 begin 121 return Get_Named_Item (Elem.Attributes, Name); 122 end Get_Attribute_Node; 123 124 --------------------------- 125 -- Get_Attribute_Node_Ns -- 126 --------------------------- 127 128 function Get_Attribute_Node_NS 129 (Elem : Element; Namespace_URI : DOM_String; Local_Name : DOM_String) 130 return Attr is 131 begin 132 return Get_Named_Item_NS (Elem.Attributes, Namespace_URI, Local_Name); 133 end Get_Attribute_Node_NS; 134 135 ------------------------ 136 -- Set_Attribute_Node -- 137 ------------------------ 138 139 function Set_Attribute_Node (Elem : Element; New_Attr : Attr) return Attr is 140 begin 141 if Owner_Element (New_Attr) /= null then 142 raise Inuse_Attribute_Err; 143 end if; 144 Set_Named_Item (Elem.Attributes, New_Attr); 145 New_Attr.Owner_Element := Elem; 146 return New_Attr; 147 end Set_Attribute_Node; 148 149 --------------------------- 150 -- Set_Attribute_Node_NS -- 151 --------------------------- 152 153 function Set_Attribute_Node_NS (Elem : Element; New_Attr : Attr) 154 return Attr is 155 begin 156 if Owner_Element (New_Attr) /= null then 157 raise Inuse_Attribute_Err; 158 end if; 159 Set_Named_Item_NS (Elem.Attributes, New_Attr); 160 New_Attr.Owner_Element := Elem; 161 return New_Attr; 162 end Set_Attribute_Node_NS; 163 164 --------------------------- 165 -- Remove_Attribute_Node -- 166 --------------------------- 167 168 function Remove_Attribute_Node (Elem : Element; Old_Attr : Attr) 169 return Attr is 170 begin 171 pragma Assert (Owner_Element (Old_Attr) = Elem); 172 Remove_Named_Item (Elem.Attributes, Old_Attr); 173 Old_Attr.Owner_Element := null; 174 return Old_Attr; 175 end Remove_Attribute_Node; 176 177 ------------------------------ 178 -- Remove_Attribute_Node_NS -- 179 ------------------------------ 180 181 function Remove_Attribute_Node_NS (Elem : Element; Old_Attr : Attr) 182 return Attr renames Remove_Attribute_Node; 183 184 ------------------------------ 185 -- Get_Elements_By_Tag_Name -- 186 ------------------------------ 187 188 function Get_Elements_By_Tag_Name (Elem : Element; Name : DOM_String := "*") 189 return Node_List 190 is 191 procedure Get_Elements_From_Node (N : Node; List : in out Node_List); 192 -- Depth search in N or its children/sibling for matching children. 193 194 ---------------------------- 195 -- Get_Elements_From_Node -- 196 ---------------------------- 197 198 procedure Get_Elements_From_Node (N : Node; List : in out Node_List) is 199 L : constant Node_List := Child_Nodes (N); 200 begin 201 if N.Node_Type = Element_Node 202 and then (Name = "*" or else Node_Name (N) = Name) 203 then 204 Append (List, N); 205 end if; 206 207 for J in 0 .. L.Last loop 208 Get_Elements_From_Node (L.Items (J), List); 209 end loop; 210 end Get_Elements_From_Node; 211 212 L : Node_List; 213 begin 214 Get_Elements_From_Node (Elem, L); 215 return L; 216 end Get_Elements_By_Tag_Name; 217 218 --------------------------------- 219 -- Get_Elements_By_Tag_Name_NS -- 220 --------------------------------- 221 222 function Get_Elements_By_Tag_Name_NS 223 (Elem : Element; 224 Namespace_URI : DOM_String := "*"; 225 Local_Name : DOM_String := "*") 226 return Node_List 227 is 228 procedure Get_Elements_From_Node (N : Node; List : in out Node_List); 229 -- Depth search in N or its children/sibling for matching children. 230 231 ---------------------------- 232 -- Get_Elements_From_Node -- 233 ---------------------------- 234 235 procedure Get_Elements_From_Node (N : Node; List : in out Node_List) is 236 L : constant Node_List := Child_Nodes (N); 237 begin 238 if N.Node_Type = Element_Node 239 and then (Namespace_URI = "*" 240 or else DOM.Core.Nodes.Namespace_URI (N) = Namespace_URI) 241 and then 242 (Local_Name = "*" 243 or else Symbol'(DOM.Core.Nodes.Local_Name (N)) = Local_Name) 244 then 245 Append (List, N); 246 end if; 247 248 for J in 0 .. L.Last loop 249 Get_Elements_From_Node (L.Items (J), List); 250 end loop; 251 end Get_Elements_From_Node; 252 253 L : Node_List; 254 begin 255 Get_Elements_From_Node (Elem, L); 256 return L; 257 end Get_Elements_By_Tag_Name_NS; 258 259 ---------------------- 260 -- Set_Id_Attribute -- 261 ---------------------- 262 263 procedure Set_Id_Attribute 264 (Elem : Element; 265 Name : DOM_String; 266 Is_Id : Boolean) 267 is 268 Id_Attr : constant Attr := Get_Attribute_Node (Elem, Name); 269 begin 270 if Id_Attr = null then 271 raise Not_Found_Err; 272 end if; 273 274 Id_Attr.Is_Id := Is_Id; 275 276 if Is_Id then 277 Document_Add_Id 278 (Owner_Document (Elem), Id => Id_Attr.Attr_Value, Elem => Elem); 279 else 280 Document_Remove_Id (Owner_Document (Elem), Id => Id_Attr.Attr_Value); 281 end if; 282 end Set_Id_Attribute; 283 284 ------------------------- 285 -- Set_Id_Attribute_NS -- 286 ------------------------- 287 288 procedure Set_Id_Attribute_NS 289 (Elem : Element; 290 Namespace_URI : DOM_String; 291 Local_Name : DOM_String; 292 Is_Id : Boolean) 293 is 294 Id_Attr : constant Attr := Get_Attribute_Node_NS 295 (Elem, Namespace_URI, Local_Name); 296 begin 297 if Id_Attr = null then 298 raise Not_Found_Err; 299 end if; 300 301 Id_Attr.Is_Id := Is_Id; 302 303 if Is_Id then 304 Document_Add_Id 305 (Owner_Document (Elem), Id => Id_Attr.Attr_Value, Elem => Elem); 306 else 307 Document_Remove_Id (Owner_Document (Elem), Id => Id_Attr.Attr_Value); 308 end if; 309 end Set_Id_Attribute_NS; 310 311 --------------------------- 312 -- Set_Id_Attribute_Node -- 313 --------------------------- 314 315 procedure Set_Id_Attribute_Node 316 (Elem : Element; Id_Attr : Attr; Is_Id : Boolean) is 317 begin 318 if Owner_Element (Id_Attr) /= Elem then 319 raise Not_Found_Err; 320 end if; 321 322 Id_Attr.Is_Id := Is_Id; 323 324 if Is_Id then 325 Document_Add_Id 326 (Owner_Document (Elem), Id => Id_Attr.Attr_Value, Elem => Elem); 327 else 328 Document_Remove_Id (Owner_Document (Elem), Id => Id_Attr.Attr_Value); 329 end if; 330 end Set_Id_Attribute_Node; 331 332end DOM.Core.Elements; 333