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