1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . S T R I N G S . W I D E _ F I X 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_Wide_Maps; use Ada.Strings.Wide_Wide_Maps; 33with Ada.Strings.Wide_Wide_Search; 34 35package body Ada.Strings.Wide_Wide_Fixed is 36 37 ------------------------ 38 -- Search Subprograms -- 39 ------------------------ 40 41 function Index 42 (Source : Wide_Wide_String; 43 Pattern : Wide_Wide_String; 44 Going : Direction := Forward; 45 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := 46 Wide_Wide_Maps.Identity) 47 return Natural 48 renames Ada.Strings.Wide_Wide_Search.Index; 49 50 function Index 51 (Source : Wide_Wide_String; 52 Pattern : Wide_Wide_String; 53 Going : Direction := Forward; 54 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 55 return Natural 56 renames Ada.Strings.Wide_Wide_Search.Index; 57 58 function Index 59 (Source : Wide_Wide_String; 60 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 61 Test : Membership := Inside; 62 Going : Direction := Forward) return Natural 63 renames Ada.Strings.Wide_Wide_Search.Index; 64 65 function Index 66 (Source : Wide_Wide_String; 67 Pattern : Wide_Wide_String; 68 From : Positive; 69 Going : Direction := Forward; 70 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := 71 Wide_Wide_Maps.Identity) 72 return Natural 73 renames Ada.Strings.Wide_Wide_Search.Index; 74 75 function Index 76 (Source : Wide_Wide_String; 77 Pattern : Wide_Wide_String; 78 From : Positive; 79 Going : Direction := Forward; 80 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 81 return Natural 82 renames Ada.Strings.Wide_Wide_Search.Index; 83 84 function Index 85 (Source : Wide_Wide_String; 86 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 87 From : Positive; 88 Test : Membership := Inside; 89 Going : Direction := Forward) return Natural 90 renames Ada.Strings.Wide_Wide_Search.Index; 91 92 function Index_Non_Blank 93 (Source : Wide_Wide_String; 94 Going : Direction := Forward) return Natural 95 renames Ada.Strings.Wide_Wide_Search.Index_Non_Blank; 96 97 function Index_Non_Blank 98 (Source : Wide_Wide_String; 99 From : Positive; 100 Going : Direction := Forward) return Natural 101 renames Ada.Strings.Wide_Wide_Search.Index_Non_Blank; 102 103 function Count 104 (Source : Wide_Wide_String; 105 Pattern : Wide_Wide_String; 106 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := 107 Wide_Wide_Maps.Identity) 108 return Natural 109 renames Ada.Strings.Wide_Wide_Search.Count; 110 111 function Count 112 (Source : Wide_Wide_String; 113 Pattern : Wide_Wide_String; 114 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 115 return Natural 116 renames Ada.Strings.Wide_Wide_Search.Count; 117 118 function Count 119 (Source : Wide_Wide_String; 120 Set : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural 121 renames Ada.Strings.Wide_Wide_Search.Count; 122 123 procedure Find_Token 124 (Source : Wide_Wide_String; 125 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 126 From : Positive; 127 Test : Membership; 128 First : out Positive; 129 Last : out Natural) 130 renames Ada.Strings.Wide_Wide_Search.Find_Token; 131 132 procedure Find_Token 133 (Source : Wide_Wide_String; 134 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 135 Test : Membership; 136 First : out Positive; 137 Last : out Natural) 138 renames Ada.Strings.Wide_Wide_Search.Find_Token; 139 140 --------- 141 -- "*" -- 142 --------- 143 144 function "*" 145 (Left : Natural; 146 Right : Wide_Wide_Character) return Wide_Wide_String 147 is 148 Result : Wide_Wide_String (1 .. Left); 149 150 begin 151 for J in Result'Range loop 152 Result (J) := Right; 153 end loop; 154 155 return Result; 156 end "*"; 157 158 function "*" 159 (Left : Natural; 160 Right : Wide_Wide_String) return Wide_Wide_String 161 is 162 Result : Wide_Wide_String (1 .. Left * Right'Length); 163 Ptr : Integer := 1; 164 165 begin 166 for J in 1 .. Left loop 167 Result (Ptr .. Ptr + Right'Length - 1) := Right; 168 Ptr := Ptr + Right'Length; 169 end loop; 170 171 return Result; 172 end "*"; 173 174 ------------ 175 -- Delete -- 176 ------------ 177 178 function Delete 179 (Source : Wide_Wide_String; 180 From : Positive; 181 Through : Natural) return Wide_Wide_String 182 is 183 begin 184 if From not in Source'Range 185 or else Through > Source'Last 186 then 187 raise Index_Error; 188 189 elsif From > Through then 190 return Source; 191 192 else 193 declare 194 Len : constant Integer := Source'Length - (Through - From + 1); 195 Result : constant Wide_Wide_String 196 (Source'First .. Source'First + Len - 1) := 197 Source (Source'First .. From - 1) & 198 Source (Through + 1 .. Source'Last); 199 begin 200 return Result; 201 end; 202 end if; 203 end Delete; 204 205 procedure Delete 206 (Source : in out Wide_Wide_String; 207 From : Positive; 208 Through : Natural; 209 Justify : Alignment := Left; 210 Pad : Wide_Wide_Character := Wide_Wide_Space) 211 is 212 begin 213 Move (Source => Delete (Source, From, Through), 214 Target => Source, 215 Justify => Justify, 216 Pad => Pad); 217 end Delete; 218 219 ---------- 220 -- Head -- 221 ---------- 222 223 function Head 224 (Source : Wide_Wide_String; 225 Count : Natural; 226 Pad : Wide_Wide_Character := Wide_Wide_Space) return Wide_Wide_String 227 is 228 Result : Wide_Wide_String (1 .. Count); 229 230 begin 231 if Count <= Source'Length then 232 Result := Source (Source'First .. Source'First + Count - 1); 233 234 else 235 Result (1 .. Source'Length) := Source; 236 237 for J in Source'Length + 1 .. Count loop 238 Result (J) := Pad; 239 end loop; 240 end if; 241 242 return Result; 243 end Head; 244 245 procedure Head 246 (Source : in out Wide_Wide_String; 247 Count : Natural; 248 Justify : Alignment := Left; 249 Pad : Wide_Wide_Character := Ada.Strings.Wide_Wide_Space) 250 is 251 begin 252 Move (Source => Head (Source, Count, Pad), 253 Target => Source, 254 Drop => Error, 255 Justify => Justify, 256 Pad => Pad); 257 end Head; 258 259 ------------ 260 -- Insert -- 261 ------------ 262 263 function Insert 264 (Source : Wide_Wide_String; 265 Before : Positive; 266 New_Item : Wide_Wide_String) return Wide_Wide_String 267 is 268 Result : Wide_Wide_String (1 .. Source'Length + New_Item'Length); 269 270 begin 271 if Before < Source'First or else Before > Source'Last + 1 then 272 raise Index_Error; 273 end if; 274 275 Result := Source (Source'First .. Before - 1) & New_Item & 276 Source (Before .. Source'Last); 277 return Result; 278 end Insert; 279 280 procedure Insert 281 (Source : in out Wide_Wide_String; 282 Before : Positive; 283 New_Item : Wide_Wide_String; 284 Drop : Truncation := Error) 285 is 286 begin 287 Move (Source => Insert (Source, Before, New_Item), 288 Target => Source, 289 Drop => Drop); 290 end Insert; 291 292 ---------- 293 -- Move -- 294 ---------- 295 296 procedure Move 297 (Source : Wide_Wide_String; 298 Target : out Wide_Wide_String; 299 Drop : Truncation := Error; 300 Justify : Alignment := Left; 301 Pad : Wide_Wide_Character := Wide_Wide_Space) 302 is 303 Sfirst : constant Integer := Source'First; 304 Slast : constant Integer := Source'Last; 305 Slength : constant Integer := Source'Length; 306 307 Tfirst : constant Integer := Target'First; 308 Tlast : constant Integer := Target'Last; 309 Tlength : constant Integer := Target'Length; 310 311 function Is_Padding (Item : Wide_Wide_String) return Boolean; 312 -- Determinbe if all characters in Item are pad characters 313 314 function Is_Padding (Item : Wide_Wide_String) return Boolean is 315 begin 316 for J in Item'Range loop 317 if Item (J) /= Pad then 318 return False; 319 end if; 320 end loop; 321 322 return True; 323 end Is_Padding; 324 325 -- Start of processing for Move 326 327 begin 328 if Slength = Tlength then 329 Target := Source; 330 331 elsif Slength > Tlength then 332 333 case Drop is 334 when Left => 335 Target := Source (Slast - Tlength + 1 .. Slast); 336 337 when Right => 338 Target := Source (Sfirst .. Sfirst + Tlength - 1); 339 340 when Error => 341 case Justify is 342 when Left => 343 if Is_Padding (Source (Sfirst + Tlength .. Slast)) then 344 Target := 345 Source (Sfirst .. Sfirst + Target'Length - 1); 346 else 347 raise Length_Error; 348 end if; 349 350 when Right => 351 if Is_Padding (Source (Sfirst .. Slast - Tlength)) then 352 Target := Source (Slast - Tlength + 1 .. Slast); 353 else 354 raise Length_Error; 355 end if; 356 357 when Center => 358 raise Length_Error; 359 end case; 360 361 end case; 362 363 -- Source'Length < Target'Length 364 365 else 366 case Justify is 367 when Left => 368 Target (Tfirst .. Tfirst + Slength - 1) := Source; 369 370 for J in Tfirst + Slength .. Tlast loop 371 Target (J) := Pad; 372 end loop; 373 374 when Right => 375 for J in Tfirst .. Tlast - Slength loop 376 Target (J) := Pad; 377 end loop; 378 379 Target (Tlast - Slength + 1 .. Tlast) := Source; 380 381 when Center => 382 declare 383 Front_Pad : constant Integer := (Tlength - Slength) / 2; 384 Tfirst_Fpad : constant Integer := Tfirst + Front_Pad; 385 386 begin 387 for J in Tfirst .. Tfirst_Fpad - 1 loop 388 Target (J) := Pad; 389 end loop; 390 391 Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source; 392 393 for J in Tfirst_Fpad + Slength .. Tlast loop 394 Target (J) := Pad; 395 end loop; 396 end; 397 end case; 398 end if; 399 end Move; 400 401 --------------- 402 -- Overwrite -- 403 --------------- 404 405 function Overwrite 406 (Source : Wide_Wide_String; 407 Position : Positive; 408 New_Item : Wide_Wide_String) return Wide_Wide_String 409 is 410 begin 411 if Position not in Source'First .. Source'Last + 1 then 412 raise Index_Error; 413 else 414 declare 415 Result_Length : constant Natural := 416 Natural'Max 417 (Source'Length, 418 Position - Source'First + New_Item'Length); 419 420 Result : Wide_Wide_String (1 .. Result_Length); 421 422 begin 423 Result := Source (Source'First .. Position - 1) & New_Item & 424 Source (Position + New_Item'Length .. Source'Last); 425 return Result; 426 end; 427 end if; 428 end Overwrite; 429 430 procedure Overwrite 431 (Source : in out Wide_Wide_String; 432 Position : Positive; 433 New_Item : Wide_Wide_String; 434 Drop : Truncation := Right) 435 is 436 begin 437 Move (Source => Overwrite (Source, Position, New_Item), 438 Target => Source, 439 Drop => Drop); 440 end Overwrite; 441 442 ------------------- 443 -- Replace_Slice -- 444 ------------------- 445 446 function Replace_Slice 447 (Source : Wide_Wide_String; 448 Low : Positive; 449 High : Natural; 450 By : Wide_Wide_String) return Wide_Wide_String 451 is 452 begin 453 if Low > Source'Last + 1 or else High < Source'First - 1 then 454 raise Index_Error; 455 end if; 456 457 if High >= Low then 458 declare 459 Front_Len : constant Integer := 460 Integer'Max (0, Low - Source'First); 461 -- Length of prefix of Source copied to result 462 463 Back_Len : constant Integer := 464 Integer'Max (0, Source'Last - High); 465 -- Length of suffix of Source copied to result 466 467 Result_Length : constant Integer := 468 Front_Len + By'Length + Back_Len; 469 -- Length of result 470 471 Result : Wide_Wide_String (1 .. Result_Length); 472 473 begin 474 Result (1 .. Front_Len) := Source (Source'First .. Low - 1); 475 Result (Front_Len + 1 .. Front_Len + By'Length) := By; 476 Result (Front_Len + By'Length + 1 .. Result'Length) := 477 Source (High + 1 .. Source'Last); 478 return Result; 479 end; 480 481 else 482 return Insert (Source, Before => Low, New_Item => By); 483 end if; 484 end Replace_Slice; 485 486 procedure Replace_Slice 487 (Source : in out Wide_Wide_String; 488 Low : Positive; 489 High : Natural; 490 By : Wide_Wide_String; 491 Drop : Truncation := Error; 492 Justify : Alignment := Left; 493 Pad : Wide_Wide_Character := Wide_Wide_Space) 494 is 495 begin 496 Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad); 497 end Replace_Slice; 498 499 ---------- 500 -- Tail -- 501 ---------- 502 503 function Tail 504 (Source : Wide_Wide_String; 505 Count : Natural; 506 Pad : Wide_Wide_Character := Wide_Wide_Space) return Wide_Wide_String 507 is 508 Result : Wide_Wide_String (1 .. Count); 509 510 begin 511 if Count < Source'Length then 512 Result := Source (Source'Last - Count + 1 .. Source'Last); 513 514 -- Pad on left 515 516 else 517 for J in 1 .. Count - Source'Length loop 518 Result (J) := Pad; 519 end loop; 520 521 Result (Count - Source'Length + 1 .. Count) := Source; 522 end if; 523 524 return Result; 525 end Tail; 526 527 procedure Tail 528 (Source : in out Wide_Wide_String; 529 Count : Natural; 530 Justify : Alignment := Left; 531 Pad : Wide_Wide_Character := Ada.Strings.Wide_Wide_Space) 532 is 533 begin 534 Move (Source => Tail (Source, Count, Pad), 535 Target => Source, 536 Drop => Error, 537 Justify => Justify, 538 Pad => Pad); 539 end Tail; 540 541 --------------- 542 -- Translate -- 543 --------------- 544 545 function Translate 546 (Source : Wide_Wide_String; 547 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping) 548 return Wide_Wide_String 549 is 550 Result : Wide_Wide_String (1 .. Source'Length); 551 552 begin 553 for J in Source'Range loop 554 Result (J - (Source'First - 1)) := Value (Mapping, Source (J)); 555 end loop; 556 557 return Result; 558 end Translate; 559 560 procedure Translate 561 (Source : in out Wide_Wide_String; 562 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping) 563 is 564 begin 565 for J in Source'Range loop 566 Source (J) := Value (Mapping, Source (J)); 567 end loop; 568 end Translate; 569 570 function Translate 571 (Source : Wide_Wide_String; 572 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 573 return Wide_Wide_String 574 is 575 Result : Wide_Wide_String (1 .. Source'Length); 576 577 begin 578 for J in Source'Range loop 579 Result (J - (Source'First - 1)) := Mapping (Source (J)); 580 end loop; 581 582 return Result; 583 end Translate; 584 585 procedure Translate 586 (Source : in out Wide_Wide_String; 587 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 588 is 589 begin 590 for J in Source'Range loop 591 Source (J) := Mapping (Source (J)); 592 end loop; 593 end Translate; 594 595 ---------- 596 -- Trim -- 597 ---------- 598 599 function Trim 600 (Source : Wide_Wide_String; 601 Side : Trim_End) return Wide_Wide_String 602 is 603 Low : Natural := Source'First; 604 High : Natural := Source'Last; 605 606 begin 607 if Side = Left or else Side = Both then 608 while Low <= High and then Source (Low) = Wide_Wide_Space loop 609 Low := Low + 1; 610 end loop; 611 end if; 612 613 if Side = Right or else Side = Both then 614 while High >= Low and then Source (High) = Wide_Wide_Space loop 615 High := High - 1; 616 end loop; 617 end if; 618 619 -- All blanks case 620 621 if Low > High then 622 return ""; 623 624 -- At least one non-blank 625 626 else 627 declare 628 Result : constant Wide_Wide_String (1 .. High - Low + 1) := 629 Source (Low .. High); 630 631 begin 632 return Result; 633 end; 634 end if; 635 end Trim; 636 637 procedure Trim 638 (Source : in out Wide_Wide_String; 639 Side : Trim_End; 640 Justify : Alignment := Left; 641 Pad : Wide_Wide_Character := Wide_Wide_Space) 642 is 643 begin 644 Move (Source => Trim (Source, Side), 645 Target => Source, 646 Justify => Justify, 647 Pad => Pad); 648 end Trim; 649 650 function Trim 651 (Source : Wide_Wide_String; 652 Left : Wide_Wide_Maps.Wide_Wide_Character_Set; 653 Right : Wide_Wide_Maps.Wide_Wide_Character_Set) return Wide_Wide_String 654 is 655 Low : Natural := Source'First; 656 High : Natural := Source'Last; 657 658 begin 659 while Low <= High and then Is_In (Source (Low), Left) loop 660 Low := Low + 1; 661 end loop; 662 663 while High >= Low and then Is_In (Source (High), Right) loop 664 High := High - 1; 665 end loop; 666 667 -- Case where source comprises only characters in the sets 668 669 if Low > High then 670 return ""; 671 else 672 declare 673 subtype WS is Wide_Wide_String (1 .. High - Low + 1); 674 675 begin 676 return WS (Source (Low .. High)); 677 end; 678 end if; 679 end Trim; 680 681 procedure Trim 682 (Source : in out Wide_Wide_String; 683 Left : Wide_Wide_Maps.Wide_Wide_Character_Set; 684 Right : Wide_Wide_Maps.Wide_Wide_Character_Set; 685 Justify : Alignment := Strings.Left; 686 Pad : Wide_Wide_Character := Wide_Wide_Space) 687 is 688 begin 689 Move (Source => Trim (Source, Left, Right), 690 Target => Source, 691 Justify => Justify, 692 Pad => Pad); 693 end Trim; 694 695end Ada.Strings.Wide_Wide_Fixed; 696