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