1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . S T R I N G S . W I D E _ U N B O U N D E D -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32with Ada.Strings.Wide_Fixed; 33with Ada.Strings.Wide_Search; 34with Ada.Unchecked_Deallocation; 35 36package body Ada.Strings.Wide_Unbounded is 37 38 use Ada.Finalization; 39 40 --------- 41 -- "&" -- 42 --------- 43 44 function "&" 45 (Left : Unbounded_Wide_String; 46 Right : Unbounded_Wide_String) return Unbounded_Wide_String 47 is 48 L_Length : constant Natural := Left.Last; 49 R_Length : constant Natural := Right.Last; 50 Result : Unbounded_Wide_String; 51 52 begin 53 Result.Last := L_Length + R_Length; 54 55 Result.Reference := new Wide_String (1 .. Result.Last); 56 57 Result.Reference (1 .. L_Length) := 58 Left.Reference (1 .. Left.Last); 59 Result.Reference (L_Length + 1 .. Result.Last) := 60 Right.Reference (1 .. Right.Last); 61 62 return Result; 63 end "&"; 64 65 function "&" 66 (Left : Unbounded_Wide_String; 67 Right : Wide_String) return Unbounded_Wide_String 68 is 69 L_Length : constant Natural := Left.Last; 70 Result : Unbounded_Wide_String; 71 72 begin 73 Result.Last := L_Length + Right'Length; 74 75 Result.Reference := new Wide_String (1 .. Result.Last); 76 77 Result.Reference (1 .. L_Length) := Left.Reference (1 .. Left.Last); 78 Result.Reference (L_Length + 1 .. Result.Last) := Right; 79 80 return Result; 81 end "&"; 82 83 function "&" 84 (Left : Wide_String; 85 Right : Unbounded_Wide_String) return Unbounded_Wide_String 86 is 87 R_Length : constant Natural := Right.Last; 88 Result : Unbounded_Wide_String; 89 90 begin 91 Result.Last := Left'Length + R_Length; 92 93 Result.Reference := new Wide_String (1 .. Result.Last); 94 95 Result.Reference (1 .. Left'Length) := Left; 96 Result.Reference (Left'Length + 1 .. Result.Last) := 97 Right.Reference (1 .. Right.Last); 98 99 return Result; 100 end "&"; 101 102 function "&" 103 (Left : Unbounded_Wide_String; 104 Right : Wide_Character) return Unbounded_Wide_String 105 is 106 Result : Unbounded_Wide_String; 107 108 begin 109 Result.Last := Left.Last + 1; 110 111 Result.Reference := new Wide_String (1 .. Result.Last); 112 113 Result.Reference (1 .. Result.Last - 1) := 114 Left.Reference (1 .. Left.Last); 115 Result.Reference (Result.Last) := Right; 116 117 return Result; 118 end "&"; 119 120 function "&" 121 (Left : Wide_Character; 122 Right : Unbounded_Wide_String) return Unbounded_Wide_String 123 is 124 Result : Unbounded_Wide_String; 125 126 begin 127 Result.Last := Right.Last + 1; 128 129 Result.Reference := new Wide_String (1 .. Result.Last); 130 Result.Reference (1) := Left; 131 Result.Reference (2 .. Result.Last) := 132 Right.Reference (1 .. Right.Last); 133 return Result; 134 end "&"; 135 136 --------- 137 -- "*" -- 138 --------- 139 140 function "*" 141 (Left : Natural; 142 Right : Wide_Character) return Unbounded_Wide_String 143 is 144 Result : Unbounded_Wide_String; 145 146 begin 147 Result.Last := Left; 148 149 Result.Reference := new Wide_String (1 .. Left); 150 for J in Result.Reference'Range loop 151 Result.Reference (J) := Right; 152 end loop; 153 154 return Result; 155 end "*"; 156 157 function "*" 158 (Left : Natural; 159 Right : Wide_String) return Unbounded_Wide_String 160 is 161 Len : constant Natural := Right'Length; 162 K : Positive; 163 Result : Unbounded_Wide_String; 164 165 begin 166 Result.Last := Left * Len; 167 168 Result.Reference := new Wide_String (1 .. Result.Last); 169 170 K := 1; 171 for J in 1 .. Left loop 172 Result.Reference (K .. K + Len - 1) := Right; 173 K := K + Len; 174 end loop; 175 176 return Result; 177 end "*"; 178 179 function "*" 180 (Left : Natural; 181 Right : Unbounded_Wide_String) return Unbounded_Wide_String 182 is 183 Len : constant Natural := Right.Last; 184 K : Positive; 185 Result : Unbounded_Wide_String; 186 187 begin 188 Result.Last := Left * Len; 189 190 Result.Reference := new Wide_String (1 .. Result.Last); 191 192 K := 1; 193 for J in 1 .. Left loop 194 Result.Reference (K .. K + Len - 1) := 195 Right.Reference (1 .. Right.Last); 196 K := K + Len; 197 end loop; 198 199 return Result; 200 end "*"; 201 202 --------- 203 -- "<" -- 204 --------- 205 206 function "<" 207 (Left : Unbounded_Wide_String; 208 Right : Unbounded_Wide_String) return Boolean 209 is 210 begin 211 return 212 Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last); 213 end "<"; 214 215 function "<" 216 (Left : Unbounded_Wide_String; 217 Right : Wide_String) return Boolean 218 is 219 begin 220 return Left.Reference (1 .. Left.Last) < Right; 221 end "<"; 222 223 function "<" 224 (Left : Wide_String; 225 Right : Unbounded_Wide_String) return Boolean 226 is 227 begin 228 return Left < Right.Reference (1 .. Right.Last); 229 end "<"; 230 231 ---------- 232 -- "<=" -- 233 ---------- 234 235 function "<=" 236 (Left : Unbounded_Wide_String; 237 Right : Unbounded_Wide_String) return Boolean 238 is 239 begin 240 return 241 Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last); 242 end "<="; 243 244 function "<=" 245 (Left : Unbounded_Wide_String; 246 Right : Wide_String) return Boolean 247 is 248 begin 249 return Left.Reference (1 .. Left.Last) <= Right; 250 end "<="; 251 252 function "<=" 253 (Left : Wide_String; 254 Right : Unbounded_Wide_String) return Boolean 255 is 256 begin 257 return Left <= Right.Reference (1 .. Right.Last); 258 end "<="; 259 260 --------- 261 -- "=" -- 262 --------- 263 264 function "=" 265 (Left : Unbounded_Wide_String; 266 Right : Unbounded_Wide_String) return Boolean 267 is 268 begin 269 return 270 Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last); 271 end "="; 272 273 function "=" 274 (Left : Unbounded_Wide_String; 275 Right : Wide_String) return Boolean 276 is 277 begin 278 return Left.Reference (1 .. Left.Last) = Right; 279 end "="; 280 281 function "=" 282 (Left : Wide_String; 283 Right : Unbounded_Wide_String) return Boolean 284 is 285 begin 286 return Left = Right.Reference (1 .. Right.Last); 287 end "="; 288 289 --------- 290 -- ">" -- 291 --------- 292 293 function ">" 294 (Left : Unbounded_Wide_String; 295 Right : Unbounded_Wide_String) return Boolean 296 is 297 begin 298 return 299 Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last); 300 end ">"; 301 302 function ">" 303 (Left : Unbounded_Wide_String; 304 Right : Wide_String) return Boolean 305 is 306 begin 307 return Left.Reference (1 .. Left.Last) > Right; 308 end ">"; 309 310 function ">" 311 (Left : Wide_String; 312 Right : Unbounded_Wide_String) return Boolean 313 is 314 begin 315 return Left > Right.Reference (1 .. Right.Last); 316 end ">"; 317 318 ---------- 319 -- ">=" -- 320 ---------- 321 322 function ">=" 323 (Left : Unbounded_Wide_String; 324 Right : Unbounded_Wide_String) return Boolean 325 is 326 begin 327 return 328 Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last); 329 end ">="; 330 331 function ">=" 332 (Left : Unbounded_Wide_String; 333 Right : Wide_String) return Boolean 334 is 335 begin 336 return Left.Reference (1 .. Left.Last) >= Right; 337 end ">="; 338 339 function ">=" 340 (Left : Wide_String; 341 Right : Unbounded_Wide_String) return Boolean 342 is 343 begin 344 return Left >= Right.Reference (1 .. Right.Last); 345 end ">="; 346 347 ------------ 348 -- Adjust -- 349 ------------ 350 351 procedure Adjust (Object : in out Unbounded_Wide_String) is 352 begin 353 -- Copy string, except we do not copy the statically allocated null 354 -- string, since it can never be deallocated. Note that we do not copy 355 -- extra string room here to avoid dragging unused allocated memory. 356 357 if Object.Reference /= Null_Wide_String'Access then 358 Object.Reference := 359 new Wide_String'(Object.Reference (1 .. Object.Last)); 360 end if; 361 end Adjust; 362 363 ------------ 364 -- Append -- 365 ------------ 366 367 procedure Append 368 (Source : in out Unbounded_Wide_String; 369 New_Item : Unbounded_Wide_String) 370 is 371 begin 372 Realloc_For_Chunk (Source, New_Item.Last); 373 Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) := 374 New_Item.Reference (1 .. New_Item.Last); 375 Source.Last := Source.Last + New_Item.Last; 376 end Append; 377 378 procedure Append 379 (Source : in out Unbounded_Wide_String; 380 New_Item : Wide_String) 381 is 382 begin 383 Realloc_For_Chunk (Source, New_Item'Length); 384 Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) := 385 New_Item; 386 Source.Last := Source.Last + New_Item'Length; 387 end Append; 388 389 procedure Append 390 (Source : in out Unbounded_Wide_String; 391 New_Item : Wide_Character) 392 is 393 begin 394 Realloc_For_Chunk (Source, 1); 395 Source.Reference (Source.Last + 1) := New_Item; 396 Source.Last := Source.Last + 1; 397 end Append; 398 399 ----------- 400 -- Count -- 401 ----------- 402 403 function Count 404 (Source : Unbounded_Wide_String; 405 Pattern : Wide_String; 406 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) 407 return Natural 408 is 409 begin 410 return 411 Wide_Search.Count 412 (Source.Reference (1 .. Source.Last), Pattern, Mapping); 413 end Count; 414 415 function Count 416 (Source : Unbounded_Wide_String; 417 Pattern : Wide_String; 418 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural 419 is 420 begin 421 return 422 Wide_Search.Count 423 (Source.Reference (1 .. Source.Last), Pattern, Mapping); 424 end Count; 425 426 function Count 427 (Source : Unbounded_Wide_String; 428 Set : Wide_Maps.Wide_Character_Set) return Natural 429 is 430 begin 431 return 432 Wide_Search.Count 433 (Source.Reference (1 .. Source.Last), Set); 434 end Count; 435 436 ------------ 437 -- Delete -- 438 ------------ 439 440 function Delete 441 (Source : Unbounded_Wide_String; 442 From : Positive; 443 Through : Natural) return Unbounded_Wide_String 444 is 445 begin 446 return 447 To_Unbounded_Wide_String 448 (Wide_Fixed.Delete 449 (Source.Reference (1 .. Source.Last), From, Through)); 450 end Delete; 451 452 procedure Delete 453 (Source : in out Unbounded_Wide_String; 454 From : Positive; 455 Through : Natural) 456 is 457 begin 458 if From > Through then 459 null; 460 461 elsif From < Source.Reference'First or else Through > Source.Last then 462 raise Index_Error; 463 464 else 465 declare 466 Len : constant Natural := Through - From + 1; 467 468 begin 469 Source.Reference (From .. Source.Last - Len) := 470 Source.Reference (Through + 1 .. Source.Last); 471 Source.Last := Source.Last - Len; 472 end; 473 end if; 474 end Delete; 475 476 ------------- 477 -- Element -- 478 ------------- 479 480 function Element 481 (Source : Unbounded_Wide_String; 482 Index : Positive) return Wide_Character 483 is 484 begin 485 if Index <= Source.Last then 486 return Source.Reference (Index); 487 else 488 raise Strings.Index_Error; 489 end if; 490 end Element; 491 492 -------------- 493 -- Finalize -- 494 -------------- 495 496 procedure Finalize (Object : in out Unbounded_Wide_String) is 497 procedure Deallocate is 498 new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access); 499 500 begin 501 -- Note: Don't try to free statically allocated null string 502 503 if Object.Reference /= Null_Wide_String'Access then 504 Deallocate (Object.Reference); 505 Object.Reference := Null_Unbounded_Wide_String.Reference; 506 Object.Last := 0; 507 end if; 508 end Finalize; 509 510 ---------------- 511 -- Find_Token -- 512 ---------------- 513 514 procedure Find_Token 515 (Source : Unbounded_Wide_String; 516 Set : Wide_Maps.Wide_Character_Set; 517 From : Positive; 518 Test : Strings.Membership; 519 First : out Positive; 520 Last : out Natural) 521 is 522 begin 523 Wide_Search.Find_Token 524 (Source.Reference (From .. Source.Last), Set, Test, First, Last); 525 end Find_Token; 526 527 procedure Find_Token 528 (Source : Unbounded_Wide_String; 529 Set : Wide_Maps.Wide_Character_Set; 530 Test : Strings.Membership; 531 First : out Positive; 532 Last : out Natural) 533 is 534 begin 535 Wide_Search.Find_Token 536 (Source.Reference (1 .. Source.Last), Set, Test, First, Last); 537 end Find_Token; 538 539 ---------- 540 -- Free -- 541 ---------- 542 543 procedure Free (X : in out Wide_String_Access) is 544 procedure Deallocate is 545 new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access); 546 547 begin 548 -- Note: Do not try to free statically allocated null string 549 550 if X /= Null_Unbounded_Wide_String.Reference then 551 Deallocate (X); 552 end if; 553 end Free; 554 555 ---------- 556 -- Head -- 557 ---------- 558 559 function Head 560 (Source : Unbounded_Wide_String; 561 Count : Natural; 562 Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String 563 is 564 begin 565 return To_Unbounded_Wide_String 566 (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad)); 567 end Head; 568 569 procedure Head 570 (Source : in out Unbounded_Wide_String; 571 Count : Natural; 572 Pad : Wide_Character := Wide_Space) 573 is 574 Old : Wide_String_Access := Source.Reference; 575 begin 576 Source.Reference := 577 new Wide_String' 578 (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad)); 579 Source.Last := Source.Reference'Length; 580 Free (Old); 581 end Head; 582 583 ----------- 584 -- Index -- 585 ----------- 586 587 function Index 588 (Source : Unbounded_Wide_String; 589 Pattern : Wide_String; 590 Going : Strings.Direction := Strings.Forward; 591 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) 592 return Natural 593 is 594 begin 595 return 596 Wide_Search.Index 597 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping); 598 end Index; 599 600 function Index 601 (Source : Unbounded_Wide_String; 602 Pattern : Wide_String; 603 Going : Direction := Forward; 604 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural 605 is 606 begin 607 return 608 Wide_Search.Index 609 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping); 610 end Index; 611 612 function Index 613 (Source : Unbounded_Wide_String; 614 Set : Wide_Maps.Wide_Character_Set; 615 Test : Strings.Membership := Strings.Inside; 616 Going : Strings.Direction := Strings.Forward) return Natural 617 is 618 begin 619 return Wide_Search.Index 620 (Source.Reference (1 .. Source.Last), Set, Test, Going); 621 end Index; 622 623 function Index 624 (Source : Unbounded_Wide_String; 625 Pattern : Wide_String; 626 From : Positive; 627 Going : Direction := Forward; 628 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) 629 return Natural 630 is 631 begin 632 return 633 Wide_Search.Index 634 (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping); 635 end Index; 636 637 function Index 638 (Source : Unbounded_Wide_String; 639 Pattern : Wide_String; 640 From : Positive; 641 Going : Direction := Forward; 642 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural 643 is 644 begin 645 return 646 Wide_Search.Index 647 (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping); 648 end Index; 649 650 function Index 651 (Source : Unbounded_Wide_String; 652 Set : Wide_Maps.Wide_Character_Set; 653 From : Positive; 654 Test : Membership := Inside; 655 Going : Direction := Forward) return Natural 656 is 657 begin 658 return 659 Wide_Search.Index 660 (Source.Reference (1 .. Source.Last), Set, From, Test, Going); 661 end Index; 662 663 function Index_Non_Blank 664 (Source : Unbounded_Wide_String; 665 Going : Strings.Direction := Strings.Forward) return Natural 666 is 667 begin 668 return 669 Wide_Search.Index_Non_Blank 670 (Source.Reference (1 .. Source.Last), Going); 671 end Index_Non_Blank; 672 673 function Index_Non_Blank 674 (Source : Unbounded_Wide_String; 675 From : Positive; 676 Going : Direction := Forward) return Natural 677 is 678 begin 679 return 680 Wide_Search.Index_Non_Blank 681 (Source.Reference (1 .. Source.Last), From, Going); 682 end Index_Non_Blank; 683 684 ---------------- 685 -- Initialize -- 686 ---------------- 687 688 procedure Initialize (Object : in out Unbounded_Wide_String) is 689 begin 690 Object.Reference := Null_Unbounded_Wide_String.Reference; 691 Object.Last := 0; 692 end Initialize; 693 694 ------------ 695 -- Insert -- 696 ------------ 697 698 function Insert 699 (Source : Unbounded_Wide_String; 700 Before : Positive; 701 New_Item : Wide_String) return Unbounded_Wide_String 702 is 703 begin 704 return 705 To_Unbounded_Wide_String 706 (Wide_Fixed.Insert 707 (Source.Reference (1 .. Source.Last), Before, New_Item)); 708 end Insert; 709 710 procedure Insert 711 (Source : in out Unbounded_Wide_String; 712 Before : Positive; 713 New_Item : Wide_String) 714 is 715 begin 716 if Before not in Source.Reference'First .. Source.Last + 1 then 717 raise Index_Error; 718 end if; 719 720 Realloc_For_Chunk (Source, New_Item'Length); 721 722 Source.Reference 723 (Before + New_Item'Length .. Source.Last + New_Item'Length) := 724 Source.Reference (Before .. Source.Last); 725 726 Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item; 727 Source.Last := Source.Last + New_Item'Length; 728 end Insert; 729 730 ------------ 731 -- Length -- 732 ------------ 733 734 function Length (Source : Unbounded_Wide_String) return Natural is 735 begin 736 return Source.Last; 737 end Length; 738 739 --------------- 740 -- Overwrite -- 741 --------------- 742 743 function Overwrite 744 (Source : Unbounded_Wide_String; 745 Position : Positive; 746 New_Item : Wide_String) return Unbounded_Wide_String 747 is 748 begin 749 return 750 To_Unbounded_Wide_String 751 (Wide_Fixed.Overwrite 752 (Source.Reference (1 .. Source.Last), Position, New_Item)); 753 end Overwrite; 754 755 procedure Overwrite 756 (Source : in out Unbounded_Wide_String; 757 Position : Positive; 758 New_Item : Wide_String) 759 is 760 NL : constant Natural := New_Item'Length; 761 begin 762 if Position <= Source.Last - NL + 1 then 763 Source.Reference (Position .. Position + NL - 1) := New_Item; 764 else 765 declare 766 Old : Wide_String_Access := Source.Reference; 767 begin 768 Source.Reference := new Wide_String' 769 (Wide_Fixed.Overwrite 770 (Source.Reference (1 .. Source.Last), Position, New_Item)); 771 Source.Last := Source.Reference'Length; 772 Free (Old); 773 end; 774 end if; 775 end Overwrite; 776 777 ----------------------- 778 -- Realloc_For_Chunk -- 779 ----------------------- 780 781 procedure Realloc_For_Chunk 782 (Source : in out Unbounded_Wide_String; 783 Chunk_Size : Natural) 784 is 785 Growth_Factor : constant := 32; 786 -- The growth factor controls how much extra space is allocated when 787 -- we have to increase the size of an allocated unbounded string. By 788 -- allocating extra space, we avoid the need to reallocate on every 789 -- append, particularly important when a string is built up by repeated 790 -- append operations of small pieces. This is expressed as a factor so 791 -- 32 means add 1/32 of the length of the string as growth space. 792 793 Min_Mul_Alloc : constant := Standard'Maximum_Alignment; 794 -- Allocation will be done by a multiple of Min_Mul_Alloc This causes 795 -- no memory loss as most (all?) malloc implementations are obliged to 796 -- align the returned memory on the maximum alignment as malloc does not 797 -- know the target alignment. 798 799 S_Length : constant Natural := Source.Reference'Length; 800 801 begin 802 if Chunk_Size > S_Length - Source.Last then 803 declare 804 New_Size : constant Positive := 805 S_Length + Chunk_Size + (S_Length / Growth_Factor); 806 807 New_Rounded_Up_Size : constant Positive := 808 ((New_Size - 1) / Min_Mul_Alloc + 1) * Min_Mul_Alloc; 809 810 Tmp : constant Wide_String_Access := 811 new Wide_String (1 .. New_Rounded_Up_Size); 812 813 begin 814 Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last); 815 Free (Source.Reference); 816 Source.Reference := Tmp; 817 end; 818 end if; 819 end Realloc_For_Chunk; 820 821 --------------------- 822 -- Replace_Element -- 823 --------------------- 824 825 procedure Replace_Element 826 (Source : in out Unbounded_Wide_String; 827 Index : Positive; 828 By : Wide_Character) 829 is 830 begin 831 if Index <= Source.Last then 832 Source.Reference (Index) := By; 833 else 834 raise Strings.Index_Error; 835 end if; 836 end Replace_Element; 837 838 ------------------- 839 -- Replace_Slice -- 840 ------------------- 841 842 function Replace_Slice 843 (Source : Unbounded_Wide_String; 844 Low : Positive; 845 High : Natural; 846 By : Wide_String) return Unbounded_Wide_String 847 is 848 begin 849 return To_Unbounded_Wide_String 850 (Wide_Fixed.Replace_Slice 851 (Source.Reference (1 .. Source.Last), Low, High, By)); 852 end Replace_Slice; 853 854 procedure Replace_Slice 855 (Source : in out Unbounded_Wide_String; 856 Low : Positive; 857 High : Natural; 858 By : Wide_String) 859 is 860 Old : Wide_String_Access := Source.Reference; 861 begin 862 Source.Reference := new Wide_String' 863 (Wide_Fixed.Replace_Slice 864 (Source.Reference (1 .. Source.Last), Low, High, By)); 865 Source.Last := Source.Reference'Length; 866 Free (Old); 867 end Replace_Slice; 868 869 ------------------------------- 870 -- Set_Unbounded_Wide_String -- 871 ------------------------------- 872 873 procedure Set_Unbounded_Wide_String 874 (Target : out Unbounded_Wide_String; 875 Source : Wide_String) 876 is 877 begin 878 Target.Last := Source'Length; 879 Target.Reference := new Wide_String (1 .. Source'Length); 880 Target.Reference.all := Source; 881 end Set_Unbounded_Wide_String; 882 883 ----------- 884 -- Slice -- 885 ----------- 886 887 function Slice 888 (Source : Unbounded_Wide_String; 889 Low : Positive; 890 High : Natural) return Wide_String 891 is 892 begin 893 -- Note: test of High > Length is in accordance with AI95-00128 894 895 if Low > Source.Last + 1 or else High > Source.Last then 896 raise Index_Error; 897 else 898 return Source.Reference (Low .. High); 899 end if; 900 end Slice; 901 902 ---------- 903 -- Tail -- 904 ---------- 905 906 function Tail 907 (Source : Unbounded_Wide_String; 908 Count : Natural; 909 Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String is 910 begin 911 return To_Unbounded_Wide_String 912 (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad)); 913 end Tail; 914 915 procedure Tail 916 (Source : in out Unbounded_Wide_String; 917 Count : Natural; 918 Pad : Wide_Character := Wide_Space) 919 is 920 Old : Wide_String_Access := Source.Reference; 921 begin 922 Source.Reference := new Wide_String' 923 (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad)); 924 Source.Last := Source.Reference'Length; 925 Free (Old); 926 end Tail; 927 928 ------------------------------ 929 -- To_Unbounded_Wide_String -- 930 ------------------------------ 931 932 function To_Unbounded_Wide_String 933 (Source : Wide_String) 934 return Unbounded_Wide_String 935 is 936 Result : Unbounded_Wide_String; 937 begin 938 Result.Last := Source'Length; 939 Result.Reference := new Wide_String (1 .. Source'Length); 940 Result.Reference.all := Source; 941 return Result; 942 end To_Unbounded_Wide_String; 943 944 function To_Unbounded_Wide_String 945 (Length : Natural) return Unbounded_Wide_String 946 is 947 Result : Unbounded_Wide_String; 948 begin 949 Result.Last := Length; 950 Result.Reference := new Wide_String (1 .. Length); 951 return Result; 952 end To_Unbounded_Wide_String; 953 954 ------------------- 955 -- To_Wide_String -- 956 -------------------- 957 958 function To_Wide_String 959 (Source : Unbounded_Wide_String) 960 return Wide_String 961 is 962 begin 963 return Source.Reference (1 .. Source.Last); 964 end To_Wide_String; 965 966 --------------- 967 -- Translate -- 968 --------------- 969 970 function Translate 971 (Source : Unbounded_Wide_String; 972 Mapping : Wide_Maps.Wide_Character_Mapping) 973 return Unbounded_Wide_String 974 is 975 begin 976 return 977 To_Unbounded_Wide_String 978 (Wide_Fixed.Translate 979 (Source.Reference (1 .. Source.Last), Mapping)); 980 end Translate; 981 982 procedure Translate 983 (Source : in out Unbounded_Wide_String; 984 Mapping : Wide_Maps.Wide_Character_Mapping) 985 is 986 begin 987 Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping); 988 end Translate; 989 990 function Translate 991 (Source : Unbounded_Wide_String; 992 Mapping : Wide_Maps.Wide_Character_Mapping_Function) 993 return Unbounded_Wide_String 994 is 995 begin 996 return 997 To_Unbounded_Wide_String 998 (Wide_Fixed.Translate 999 (Source.Reference (1 .. Source.Last), Mapping)); 1000 end Translate; 1001 1002 procedure Translate 1003 (Source : in out Unbounded_Wide_String; 1004 Mapping : Wide_Maps.Wide_Character_Mapping_Function) 1005 is 1006 begin 1007 Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping); 1008 end Translate; 1009 1010 ---------- 1011 -- Trim -- 1012 ---------- 1013 1014 function Trim 1015 (Source : Unbounded_Wide_String; 1016 Side : Trim_End) return Unbounded_Wide_String 1017 is 1018 begin 1019 return 1020 To_Unbounded_Wide_String 1021 (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side)); 1022 end Trim; 1023 1024 procedure Trim 1025 (Source : in out Unbounded_Wide_String; 1026 Side : Trim_End) 1027 is 1028 Old : Wide_String_Access := Source.Reference; 1029 begin 1030 Source.Reference := 1031 new Wide_String' 1032 (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side)); 1033 Source.Last := Source.Reference'Length; 1034 Free (Old); 1035 end Trim; 1036 1037 function Trim 1038 (Source : Unbounded_Wide_String; 1039 Left : Wide_Maps.Wide_Character_Set; 1040 Right : Wide_Maps.Wide_Character_Set) 1041 return Unbounded_Wide_String 1042 is 1043 begin 1044 return 1045 To_Unbounded_Wide_String 1046 (Wide_Fixed.Trim 1047 (Source.Reference (1 .. Source.Last), Left, Right)); 1048 end Trim; 1049 1050 procedure Trim 1051 (Source : in out Unbounded_Wide_String; 1052 Left : Wide_Maps.Wide_Character_Set; 1053 Right : Wide_Maps.Wide_Character_Set) 1054 is 1055 Old : Wide_String_Access := Source.Reference; 1056 begin 1057 Source.Reference := 1058 new Wide_String' 1059 (Wide_Fixed.Trim 1060 (Source.Reference (1 .. Source.Last), Left, Right)); 1061 Source.Last := Source.Reference'Length; 1062 Free (Old); 1063 end Trim; 1064 1065 --------------------- 1066 -- Unbounded_Slice -- 1067 --------------------- 1068 1069 function Unbounded_Slice 1070 (Source : Unbounded_Wide_String; 1071 Low : Positive; 1072 High : Natural) return Unbounded_Wide_String 1073 is 1074 begin 1075 if Low > Source.Last + 1 or else High > Source.Last then 1076 raise Index_Error; 1077 else 1078 return To_Unbounded_Wide_String (Source.Reference.all (Low .. High)); 1079 end if; 1080 end Unbounded_Slice; 1081 1082 procedure Unbounded_Slice 1083 (Source : Unbounded_Wide_String; 1084 Target : out Unbounded_Wide_String; 1085 Low : Positive; 1086 High : Natural) 1087 is 1088 begin 1089 if Low > Source.Last + 1 or else High > Source.Last then 1090 raise Index_Error; 1091 else 1092 Target := 1093 To_Unbounded_Wide_String (Source.Reference.all (Low .. High)); 1094 end if; 1095 end Unbounded_Slice; 1096 1097end Ada.Strings.Wide_Unbounded; 1098