1------------------------------------------------------------------------------ 2-- -- 3-- Matreshka Project -- 4-- -- 5-- XML Processor -- 6-- -- 7-- Runtime Library Component -- 8-- -- 9------------------------------------------------------------------------------ 10-- -- 11-- Copyright © 2010, Vadim Godunko <vgodunko@gmail.com> -- 12-- All rights reserved. -- 13-- -- 14-- Redistribution and use in source and binary forms, with or without -- 15-- modification, are permitted provided that the following conditions -- 16-- are met: -- 17-- -- 18-- * Redistributions of source code must retain the above copyright -- 19-- notice, this list of conditions and the following disclaimer. -- 20-- -- 21-- * Redistributions in binary form must reproduce the above copyright -- 22-- notice, this list of conditions and the following disclaimer in the -- 23-- documentation and/or other materials provided with the distribution. -- 24-- -- 25-- * Neither the name of the Vadim Godunko, IE nor the names of its -- 26-- contributors may be used to endorse or promote products derived from -- 27-- this software without specific prior written permission. -- 28-- -- 29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -- 35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -- 36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -- 37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -- 38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- 39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 40-- -- 41------------------------------------------------------------------------------ 42-- $Revision: 2026 $ $Date: 2011-07-23 00:16:17 +0400 (Sat, 23 Jul 2011) $ 43------------------------------------------------------------------------------ 44with Ada.Unchecked_Deallocation; 45 46package body Matreshka.Internals.XML.Attribute_Tables is 47 48 procedure Free is 49 new Ada.Unchecked_Deallocation (Attribute_Array, Attribute_Array_Access); 50 51 procedure New_Attribute 52 (Self : in out Attribute_Table; 53 Name : Symbol_Identifier; 54 The_Type : Attribute_Types; 55 Attribute : out Attribute_Identifier); 56 -- Allocates new attribute with specified type. 57 58 procedure Clear (Self : in out Attribute_Table); 59 -- Clear existing data. 60 61 ------------ 62 -- Append -- 63 ------------ 64 65 procedure Append 66 (Self : in out Attribute_Table; 67 Attribute : Attribute_Identifier; 68 Next : Attribute_Identifier) is 69 begin 70 Self.Table (Attribute).Next := Next; 71 end Append; 72 73 ----------- 74 -- Clear -- 75 ----------- 76 77 procedure Clear (Self : in out Attribute_Table) is 78 begin 79 for J in Self.Table'First .. Self.Last loop 80 Matreshka.Internals.Strings.Dereference (Self.Table (J).Default); 81 end loop; 82 end Clear; 83 84 ------------- 85 -- Default -- 86 ------------- 87 88 function Default 89 (Self : Attribute_Table; 90 Attribute : Attribute_Identifier) 91 return not null Matreshka.Internals.Strings.Shared_String_Access is 92 begin 93 return Self.Table (Attribute).Default; 94 end Default; 95 96 -------------- 97 -- Finalize -- 98 -------------- 99 100 procedure Finalize (Self : in out Attribute_Table) is 101 begin 102 Clear (Self); 103 Free (Self.Table); 104 end Finalize; 105 106 ----------------- 107 -- Has_Default -- 108 ----------------- 109 110 function Has_Default 111 (Self : Attribute_Table; 112 Attribute : Attribute_Identifier) return Boolean is 113 begin 114 return 115 not (Self.Table (Attribute).Is_Required 116 or Self.Table (Attribute).Is_Implied); 117 end Has_Default; 118 119 -------------- 120 -- Is_CDATA -- 121 -------------- 122 123 function Is_CDATA 124 (Self : Attribute_Table; 125 Attribute : Attribute_Identifier) return Boolean is 126 begin 127 return Self.Table (Attribute).The_Type = CDATA; 128 end Is_CDATA; 129 130 -------------- 131 -- Is_Fixed -- 132 -------------- 133 134 function Is_Fixed 135 (Self : Attribute_Table; 136 Attribute : Attribute_Identifier) return Boolean is 137 begin 138 return Self.Table (Attribute).Is_Fixed; 139 end Is_Fixed; 140 141 ----------- 142 -- Is_ID -- 143 ----------- 144 145 function Is_ID 146 (Self : Attribute_Table; 147 Attribute : Attribute_Identifier) return Boolean is 148 begin 149 return Self.Table (Attribute).The_Type = ID; 150 end Is_ID; 151 152 ---------------- 153 -- Is_Implied -- 154 ---------------- 155 156 function Is_Implied 157 (Self : Attribute_Table; 158 Attribute : Attribute_Identifier) return Boolean is 159 begin 160 return Self.Table (Attribute).Is_Implied; 161 end Is_Implied; 162 163 ----------------- 164 -- Is_Required -- 165 ----------------- 166 167 function Is_Required 168 (Self : Attribute_Table; 169 Attribute : Attribute_Identifier) return Boolean is 170 begin 171 return Self.Table (Attribute).Is_Required; 172 end Is_Required; 173 174 ---------- 175 -- Name -- 176 ---------- 177 178 function Name 179 (Self : Attribute_Table; 180 Attribute : Attribute_Identifier) return Symbol_Identifier is 181 begin 182 return Self.Table (Attribute).Name; 183 end Name; 184 185 ------------------- 186 -- New_Attribute -- 187 ------------------- 188 189 procedure New_Attribute 190 (Self : in out Attribute_Table; 191 Name : Symbol_Identifier; 192 The_Type : Attribute_Types; 193 Attribute : out Attribute_Identifier) is 194 begin 195 Self.Last := Self.Last + 1; 196 197 if Self.Last > Self.Table'Last then 198 declare 199 Old : Attribute_Array_Access := Self.Table; 200 201 begin 202 Self.Table := new Attribute_Array (1 .. Old'Last + 16); 203 Self.Table (Old'Range) := Old.all; 204 Free (Old); 205 end; 206 end if; 207 208 Attribute := Self.Last; 209 Self.Table (Attribute) := 210 (Name => Name, 211 The_Type => The_Type, 212 Is_Required => False, 213 Is_Implied => False, 214 Is_Fixed => False, 215 Default => Matreshka.Internals.Strings.Shared_Empty'Access, 216 Next => No_Attribute); 217 end New_Attribute; 218 219 ------------------------- 220 -- New_CDATA_Attribute -- 221 ------------------------- 222 223 procedure New_CDATA_Attribute 224 (Self : in out Attribute_Table; 225 Name : Symbol_Identifier; 226 Attribute : out Attribute_Identifier) is 227 begin 228 New_Attribute (Self, Name, CDATA, Attribute); 229 end New_CDATA_Attribute; 230 231 ---------------------------- 232 -- New_Entities_Attribute -- 233 ---------------------------- 234 235 procedure New_Entities_Attribute 236 (Self : in out Attribute_Table; 237 Name : Symbol_Identifier; 238 Attribute : out Attribute_Identifier) is 239 begin 240 New_Attribute (Self, Name, ENTITIES, Attribute); 241 end New_Entities_Attribute; 242 243 -------------------------- 244 -- New_Entity_Attribute -- 245 -------------------------- 246 247 procedure New_Entity_Attribute 248 (Self : in out Attribute_Table; 249 Name : Symbol_Identifier; 250 Attribute : out Attribute_Identifier) is 251 begin 252 New_Attribute (Self, Name, ENTITY, Attribute); 253 end New_Entity_Attribute; 254 255 ------------------------------- 256 -- New_Enumeration_Attribute -- 257 ------------------------------- 258 259 procedure New_Enumeration_Attribute 260 (Self : in out Attribute_Table; 261 Name : Symbol_Identifier; 262 Attribute : out Attribute_Identifier) is 263 begin 264 New_Attribute (Self, Name, ENUMERATION, Attribute); 265 end New_Enumeration_Attribute; 266 267 ---------------------- 268 -- New_Id_Attribute -- 269 ---------------------- 270 271 procedure New_Id_Attribute 272 (Self : in out Attribute_Table; 273 Name : Symbol_Identifier; 274 Attribute : out Attribute_Identifier) is 275 begin 276 New_Attribute (Self, Name, ID, Attribute); 277 end New_Id_Attribute; 278 279 ------------------------- 280 -- New_IdRef_Attribute -- 281 ------------------------- 282 283 procedure New_IdRef_Attribute 284 (Self : in out Attribute_Table; 285 Name : Symbol_Identifier; 286 Attribute : out Attribute_Identifier) is 287 begin 288 New_Attribute (Self, Name, IDREF, Attribute); 289 end New_IdRef_Attribute; 290 291 -------------------------- 292 -- New_IdRefs_Attribute -- 293 -------------------------- 294 295 procedure New_IdRefs_Attribute 296 (Self : in out Attribute_Table; 297 Name : Symbol_Identifier; 298 Attribute : out Attribute_Identifier) is 299 begin 300 New_Attribute (Self, Name, IDREFS, Attribute); 301 end New_IdRefs_Attribute; 302 303 --------------------------- 304 -- New_NmToken_Attribute -- 305 --------------------------- 306 307 procedure New_NmToken_Attribute 308 (Self : in out Attribute_Table; 309 Name : Symbol_Identifier; 310 Attribute : out Attribute_Identifier) is 311 begin 312 New_Attribute (Self, Name, NMTOKEN, Attribute); 313 end New_NmToken_Attribute; 314 315 ---------------------------- 316 -- New_NmTokens_Attribute -- 317 ---------------------------- 318 319 procedure New_NmTokens_Attribute 320 (Self : in out Attribute_Table; 321 Name : Symbol_Identifier; 322 Attribute : out Attribute_Identifier) is 323 begin 324 New_Attribute (Self, Name, NMTOKENS, Attribute); 325 end New_NmTokens_Attribute; 326 327 ---------------------------- 328 -- New_Notation_Attribute -- 329 ---------------------------- 330 331 procedure New_Notation_Attribute 332 (Self : in out Attribute_Table; 333 Name : Symbol_Identifier; 334 Attribute : out Attribute_Identifier) is 335 begin 336 New_Attribute (Self, Name, NOTATION, Attribute); 337 end New_Notation_Attribute; 338 339 ---------- 340 -- Next -- 341 ---------- 342 343 function Next 344 (Self : Attribute_Table; 345 Attribute : Attribute_Identifier) return Attribute_Identifier is 346 begin 347 return Self.Table (Attribute).Next; 348 end Next; 349 350 ----------- 351 -- Reset -- 352 ----------- 353 354 procedure Reset (Self : in out Attribute_Table) is 355 begin 356 Clear (Self); 357 358 -- Resets to initial state. 359 360 Self.Last := No_Attribute; 361 end Reset; 362 363 ----------------- 364 -- Set_Default -- 365 ----------------- 366 367 procedure Set_Default 368 (Self : in out Attribute_Table; 369 Attribute : Attribute_Identifier; 370 Value : not null Matreshka.Internals.Strings.Shared_String_Access) is 371 begin 372 Matreshka.Internals.Strings.Reference (Value); 373 Self.Table (Attribute).Default := Value; 374 end Set_Default; 375 376 ------------------ 377 -- Set_Is_Fixed -- 378 ------------------ 379 380 procedure Set_Is_Fixed 381 (Self : in out Attribute_Table; 382 Attribute : Attribute_Identifier; 383 Value : Boolean) is 384 begin 385 Self.Table (Attribute).Is_Fixed := Value; 386 end Set_Is_Fixed; 387 388 -------------------- 389 -- Set_Is_Implied -- 390 -------------------- 391 392 procedure Set_Is_Implied 393 (Self : in out Attribute_Table; 394 Attribute : Attribute_Identifier; 395 Value : Boolean) is 396 begin 397 Self.Table (Attribute).Is_Implied := Value; 398 end Set_Is_Implied; 399 400 --------------------- 401 -- Set_Is_Required -- 402 --------------------- 403 404 procedure Set_Is_Required 405 (Self : in out Attribute_Table; 406 Attribute : Attribute_Identifier; 407 Value : Boolean) is 408 begin 409 Self.Table (Attribute).Is_Required := Value; 410 end Set_Is_Required; 411 412 ------------------------- 413 -- Symbol_Of_Type_Name -- 414 ------------------------- 415 416 function Symbol_Of_Type_Name 417 (Self : Attribute_Table; 418 Attribute : Attribute_Identifier) return Symbol_Identifier is 419 begin 420 case Self.Table (Attribute).The_Type is 421 when CDATA => 422 return Symbol_CDATA; 423 424 when ENTITIES => 425 return Symbol_ENTITIES; 426 427 when ENTITY => 428 return Symbol_ENTITY; 429 430 when ID => 431 return Symbol_ID; 432 433 when IDREF => 434 return Symbol_IDREF; 435 436 when IDREFS => 437 return Symbol_IDREFS; 438 439 when NMTOKEN => 440 return Symbol_NMTOKEN; 441 442 when NMTOKENS => 443 return Symbol_NMTOKENS; 444 445 when NOTATION => 446 return Symbol_NOTATION; 447 448 when ENUMERATION => 449 -- [SAX2] Attribiutes::getType 450 -- 451 -- "For an enumerated attribute that is not a notation, the parser 452 -- will report the type as "NMTOKEN"." 453 454 return Symbol_NMTOKEN; 455 end case; 456 end Symbol_Of_Type_Name; 457 458end Matreshka.Internals.XML.Attribute_Tables; 459