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-2018, 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 case Drop is 333 when Left => 334 Target := Source (Slast - Tlength + 1 .. Slast); 335 336 when Right => 337 Target := Source (Sfirst .. Sfirst + Tlength - 1); 338 339 when Error => 340 case Justify is 341 when Left => 342 if Is_Padding (Source (Sfirst + Tlength .. Slast)) then 343 Target := 344 Source (Sfirst .. Sfirst + Target'Length - 1); 345 else 346 raise Length_Error; 347 end if; 348 349 when Right => 350 if Is_Padding (Source (Sfirst .. Slast - Tlength)) then 351 Target := Source (Slast - Tlength + 1 .. Slast); 352 else 353 raise Length_Error; 354 end if; 355 356 when Center => 357 raise Length_Error; 358 end case; 359 360 end case; 361 362 -- Source'Length < Target'Length 363 364 else 365 case Justify is 366 when Left => 367 Target (Tfirst .. Tfirst + Slength - 1) := Source; 368 369 for J in Tfirst + Slength .. Tlast loop 370 Target (J) := Pad; 371 end loop; 372 373 when Right => 374 for J in Tfirst .. Tlast - Slength loop 375 Target (J) := Pad; 376 end loop; 377 378 Target (Tlast - Slength + 1 .. Tlast) := Source; 379 380 when Center => 381 declare 382 Front_Pad : constant Integer := (Tlength - Slength) / 2; 383 Tfirst_Fpad : constant Integer := Tfirst + Front_Pad; 384 385 begin 386 for J in Tfirst .. Tfirst_Fpad - 1 loop 387 Target (J) := Pad; 388 end loop; 389 390 Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source; 391 392 for J in Tfirst_Fpad + Slength .. Tlast loop 393 Target (J) := Pad; 394 end loop; 395 end; 396 end case; 397 end if; 398 end Move; 399 400 --------------- 401 -- Overwrite -- 402 --------------- 403 404 function Overwrite 405 (Source : Wide_Wide_String; 406 Position : Positive; 407 New_Item : Wide_Wide_String) return Wide_Wide_String 408 is 409 begin 410 if Position not in Source'First .. Source'Last + 1 then 411 raise Index_Error; 412 else 413 declare 414 Result_Length : constant Natural := 415 Natural'Max 416 (Source'Length, 417 Position - Source'First + New_Item'Length); 418 419 Result : Wide_Wide_String (1 .. Result_Length); 420 421 begin 422 Result := Source (Source'First .. Position - 1) & New_Item & 423 Source (Position + New_Item'Length .. Source'Last); 424 return Result; 425 end; 426 end if; 427 end Overwrite; 428 429 procedure Overwrite 430 (Source : in out Wide_Wide_String; 431 Position : Positive; 432 New_Item : Wide_Wide_String; 433 Drop : Truncation := Right) 434 is 435 begin 436 Move (Source => Overwrite (Source, Position, New_Item), 437 Target => Source, 438 Drop => Drop); 439 end Overwrite; 440 441 ------------------- 442 -- Replace_Slice -- 443 ------------------- 444 445 function Replace_Slice 446 (Source : Wide_Wide_String; 447 Low : Positive; 448 High : Natural; 449 By : Wide_Wide_String) return Wide_Wide_String 450 is 451 begin 452 if Low > Source'Last + 1 or else High < Source'First - 1 then 453 raise Index_Error; 454 end if; 455 456 if High >= Low then 457 declare 458 Front_Len : constant Integer := 459 Integer'Max (0, Low - Source'First); 460 -- Length of prefix of Source copied to result 461 462 Back_Len : constant Integer := 463 Integer'Max (0, Source'Last - High); 464 -- Length of suffix of Source copied to result 465 466 Result_Length : constant Integer := 467 Front_Len + By'Length + Back_Len; 468 -- Length of result 469 470 Result : Wide_Wide_String (1 .. Result_Length); 471 472 begin 473 Result (1 .. Front_Len) := Source (Source'First .. Low - 1); 474 Result (Front_Len + 1 .. Front_Len + By'Length) := By; 475 Result (Front_Len + By'Length + 1 .. Result'Length) := 476 Source (High + 1 .. Source'Last); 477 return Result; 478 end; 479 480 else 481 return Insert (Source, Before => Low, New_Item => By); 482 end if; 483 end Replace_Slice; 484 485 procedure Replace_Slice 486 (Source : in out Wide_Wide_String; 487 Low : Positive; 488 High : Natural; 489 By : Wide_Wide_String; 490 Drop : Truncation := Error; 491 Justify : Alignment := Left; 492 Pad : Wide_Wide_Character := Wide_Wide_Space) 493 is 494 begin 495 Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad); 496 end Replace_Slice; 497 498 ---------- 499 -- Tail -- 500 ---------- 501 502 function Tail 503 (Source : Wide_Wide_String; 504 Count : Natural; 505 Pad : Wide_Wide_Character := Wide_Wide_Space) return Wide_Wide_String 506 is 507 Result : Wide_Wide_String (1 .. Count); 508 509 begin 510 if Count < Source'Length then 511 Result := Source (Source'Last - Count + 1 .. Source'Last); 512 513 -- Pad on left 514 515 else 516 for J in 1 .. Count - Source'Length loop 517 Result (J) := Pad; 518 end loop; 519 520 Result (Count - Source'Length + 1 .. Count) := Source; 521 end if; 522 523 return Result; 524 end Tail; 525 526 procedure Tail 527 (Source : in out Wide_Wide_String; 528 Count : Natural; 529 Justify : Alignment := Left; 530 Pad : Wide_Wide_Character := Ada.Strings.Wide_Wide_Space) 531 is 532 begin 533 Move (Source => Tail (Source, Count, Pad), 534 Target => Source, 535 Drop => Error, 536 Justify => Justify, 537 Pad => Pad); 538 end Tail; 539 540 --------------- 541 -- Translate -- 542 --------------- 543 544 function Translate 545 (Source : Wide_Wide_String; 546 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping) 547 return Wide_Wide_String 548 is 549 Result : Wide_Wide_String (1 .. Source'Length); 550 551 begin 552 for J in Source'Range loop 553 Result (J - (Source'First - 1)) := Value (Mapping, Source (J)); 554 end loop; 555 556 return Result; 557 end Translate; 558 559 procedure Translate 560 (Source : in out Wide_Wide_String; 561 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping) 562 is 563 begin 564 for J in Source'Range loop 565 Source (J) := Value (Mapping, Source (J)); 566 end loop; 567 end Translate; 568 569 function Translate 570 (Source : Wide_Wide_String; 571 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 572 return Wide_Wide_String 573 is 574 Result : Wide_Wide_String (1 .. Source'Length); 575 576 begin 577 for J in Source'Range loop 578 Result (J - (Source'First - 1)) := Mapping (Source (J)); 579 end loop; 580 581 return Result; 582 end Translate; 583 584 procedure Translate 585 (Source : in out Wide_Wide_String; 586 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 587 is 588 begin 589 for J in Source'Range loop 590 Source (J) := Mapping (Source (J)); 591 end loop; 592 end Translate; 593 594 ---------- 595 -- Trim -- 596 ---------- 597 598 function Trim 599 (Source : Wide_Wide_String; 600 Side : Trim_End) return Wide_Wide_String 601 is 602 Low : Natural := Source'First; 603 High : Natural := Source'Last; 604 605 begin 606 if Side = Left or else Side = Both then 607 while Low <= High and then Source (Low) = Wide_Wide_Space loop 608 Low := Low + 1; 609 end loop; 610 end if; 611 612 if Side = Right or else Side = Both then 613 while High >= Low and then Source (High) = Wide_Wide_Space loop 614 High := High - 1; 615 end loop; 616 end if; 617 618 -- All blanks case 619 620 if Low > High then 621 return ""; 622 623 -- At least one non-blank 624 625 else 626 declare 627 Result : constant Wide_Wide_String (1 .. High - Low + 1) := 628 Source (Low .. High); 629 630 begin 631 return Result; 632 end; 633 end if; 634 end Trim; 635 636 procedure Trim 637 (Source : in out Wide_Wide_String; 638 Side : Trim_End; 639 Justify : Alignment := Left; 640 Pad : Wide_Wide_Character := Wide_Wide_Space) 641 is 642 begin 643 Move (Source => Trim (Source, Side), 644 Target => Source, 645 Justify => Justify, 646 Pad => Pad); 647 end Trim; 648 649 function Trim 650 (Source : Wide_Wide_String; 651 Left : Wide_Wide_Maps.Wide_Wide_Character_Set; 652 Right : Wide_Wide_Maps.Wide_Wide_Character_Set) return Wide_Wide_String 653 is 654 Low : Natural := Source'First; 655 High : Natural := Source'Last; 656 657 begin 658 while Low <= High and then Is_In (Source (Low), Left) loop 659 Low := Low + 1; 660 end loop; 661 662 while High >= Low and then Is_In (Source (High), Right) loop 663 High := High - 1; 664 end loop; 665 666 -- Case where source comprises only characters in the sets 667 668 if Low > High then 669 return ""; 670 else 671 declare 672 subtype WS is Wide_Wide_String (1 .. High - Low + 1); 673 674 begin 675 return WS (Source (Low .. High)); 676 end; 677 end if; 678 end Trim; 679 680 procedure Trim 681 (Source : in out Wide_Wide_String; 682 Left : Wide_Wide_Maps.Wide_Wide_Character_Set; 683 Right : Wide_Wide_Maps.Wide_Wide_Character_Set; 684 Justify : Alignment := Strings.Left; 685 Pad : Wide_Wide_Character := Wide_Wide_Space) 686 is 687 begin 688 Move (Source => Trim (Source, Left, Right), 689 Target => Source, 690 Justify => Justify, 691 Pad => Pad); 692 end Trim; 693 694end Ada.Strings.Wide_Wide_Fixed; 695