a-stwifi.adb 18.3 KB
Newer Older
Richard Kenner committed
1 2 3 4 5 6 7 8
------------------------------------------------------------------------------
--                                                                          --
--                         GNAT RUNTIME COMPONENTS                          --
--                                                                          --
--               A D A . S T R I N G S . W I D E _ F I X E D                --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
9
--          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
Richard Kenner committed
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
30
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
Richard Kenner committed
31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157
--                                                                          --
------------------------------------------------------------------------------

with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;
with Ada.Strings.Wide_Search;

package body Ada.Strings.Wide_Fixed is

   ------------------------
   -- Search Subprograms --
   ------------------------

   function Index
     (Source  : in Wide_String;
      Pattern : in Wide_String;
      Going   : in Direction := Forward;
      Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
      return    Natural
   renames Ada.Strings.Wide_Search.Index;

   function Index
     (Source  : in Wide_String;
      Pattern : in Wide_String;
      Going   : in Direction := Forward;
      Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
      return    Natural
   renames Ada.Strings.Wide_Search.Index;

   function Index
     (Source : in Wide_String;
      Set    : in Wide_Maps.Wide_Character_Set;
      Test   : in Membership := Inside;
      Going  : in Direction  := Forward)
      return   Natural
   renames Ada.Strings.Wide_Search.Index;

   function Index_Non_Blank
     (Source : in Wide_String;
      Going  : in Direction := Forward)
      return   Natural
   renames Ada.Strings.Wide_Search.Index_Non_Blank;

   function Count
     (Source  : in Wide_String;
      Pattern : in Wide_String;
      Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
      return    Natural
   renames Ada.Strings.Wide_Search.Count;

   function Count
     (Source   : in Wide_String;
      Pattern  : in Wide_String;
      Mapping  : in Wide_Maps.Wide_Character_Mapping_Function)
      return     Natural
   renames Ada.Strings.Wide_Search.Count;

   function Count
     (Source : in Wide_String;
      Set    : in Wide_Maps.Wide_Character_Set)
      return   Natural
   renames Ada.Strings.Wide_Search.Count;

   procedure Find_Token
     (Source : in Wide_String;
      Set    : in Wide_Maps.Wide_Character_Set;
      Test   : in Membership;
      First  : out Positive;
      Last   : out Natural)
   renames Ada.Strings.Wide_Search.Find_Token;

   ---------
   -- "*" --
   ---------

   function "*"
     (Left  : in Natural;
      Right : in Wide_Character)
      return  Wide_String
   is
      Result : Wide_String (1 .. Left);

   begin
      for J in Result'Range loop
         Result (J) := Right;
      end loop;

      return Result;
   end "*";

   function "*"
     (Left  : in Natural;
      Right : in Wide_String)
      return  Wide_String
   is
      Result : Wide_String (1 .. Left * Right'Length);
      Ptr    : Integer := 1;

   begin
      for J in 1 .. Left loop
         Result (Ptr .. Ptr + Right'Length - 1) := Right;
         Ptr := Ptr + Right'Length;
      end loop;

      return Result;
   end "*";

   ------------
   -- Delete --
   ------------

   function Delete
     (Source  : in Wide_String;
      From    : in Positive;
      Through : in Natural)
      return    Wide_String
   is
   begin
      if From not in Source'Range
        or else Through > Source'Last
      then
         raise Index_Error;

      elsif From > Through then
         return Source;

      else
         declare
158 159 160 161 162
            Len    : constant Integer := Source'Length - (Through - From + 1);
            Result : constant
                       Wide_String (Source'First .. Source'First + Len - 1) :=
                         Source (Source'First .. From - 1) &
                         Source (Through + 1 .. Source'Last);
Richard Kenner committed
163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381
         begin
            return Result;
         end;
      end if;
   end Delete;

   procedure Delete
     (Source  : in out Wide_String;
      From    : in Positive;
      Through : in Natural;
      Justify : in Alignment := Left;
      Pad     : in Wide_Character := Wide_Space)
   is
   begin
      Move (Source  => Delete (Source, From, Through),
            Target  => Source,
            Justify => Justify,
            Pad     => Pad);
   end Delete;

   ----------
   -- Head --
   ----------

   function Head
     (Source : in Wide_String;
      Count  : in Natural;
      Pad    : in Wide_Character := Wide_Space)
      return   Wide_String
   is
      Result : Wide_String (1 .. Count);

   begin
      if Count <= Source'Length then
         Result := Source (Source'First .. Source'First + Count - 1);

      else
         Result (1 .. Source'Length) := Source;

         for J in Source'Length + 1 .. Count loop
            Result (J) := Pad;
         end loop;
      end if;

      return Result;
   end Head;

   procedure Head
     (Source  : in out Wide_String;
      Count   : in Natural;
      Justify : in Alignment := Left;
      Pad     : in Wide_Character := Ada.Strings.Wide_Space)
   is
   begin
      Move (Source  => Head (Source, Count, Pad),
            Target  => Source,
            Drop    => Error,
            Justify => Justify,
            Pad     => Pad);
   end Head;

   ------------
   -- Insert --
   ------------

   function Insert
     (Source   : in Wide_String;
      Before   : in Positive;
      New_Item : in Wide_String)
      return     Wide_String
   is
      Result : Wide_String (1 .. Source'Length + New_Item'Length);

   begin
      if Before < Source'First or else Before > Source'Last + 1 then
         raise Index_Error;
      end if;

      Result := Source (Source'First .. Before - 1) & New_Item &
                Source (Before .. Source'Last);
      return Result;
   end Insert;

   procedure Insert
     (Source   : in out Wide_String;
      Before   : in Positive;
      New_Item : in Wide_String;
      Drop     : in Truncation := Error)
   is
   begin
      Move (Source => Insert (Source, Before, New_Item),
            Target => Source,
            Drop   => Drop);
   end Insert;

   ----------
   -- Move --
   ----------

   procedure Move
     (Source  : in  Wide_String;
      Target  : out Wide_String;
      Drop    : in  Truncation := Error;
      Justify : in  Alignment  := Left;
      Pad     : in  Wide_Character  := Wide_Space)
   is
      Sfirst  : constant Integer := Source'First;
      Slast   : constant Integer := Source'Last;
      Slength : constant Integer := Source'Length;

      Tfirst  : constant Integer := Target'First;
      Tlast   : constant Integer := Target'Last;
      Tlength : constant Integer := Target'Length;

      function Is_Padding (Item : Wide_String) return Boolean;
      --  Determinbe if all characters in Item are pad characters

      function Is_Padding (Item : Wide_String) return Boolean is
      begin
         for J in Item'Range loop
            if Item (J) /= Pad then
               return False;
            end if;
         end loop;

         return True;
      end Is_Padding;

   --  Start of processing for Move

   begin
      if Slength = Tlength then
         Target := Source;

      elsif Slength > Tlength then

         case Drop is
            when Left =>
               Target := Source (Slast - Tlength + 1 .. Slast);

            when Right =>
               Target := Source (Sfirst .. Sfirst + Tlength - 1);

            when Error =>
               case Justify is
                  when Left =>
                     if Is_Padding (Source (Sfirst + Tlength .. Slast)) then
                        Target :=
                          Source (Sfirst .. Sfirst + Target'Length - 1);
                     else
                        raise Length_Error;
                     end if;

                  when Right =>
                     if Is_Padding (Source (Sfirst .. Slast - Tlength)) then
                        Target := Source (Slast - Tlength + 1 .. Slast);
                     else
                        raise Length_Error;
                     end if;

                  when Center =>
                     raise Length_Error;
               end case;

         end case;

      --  Source'Length < Target'Length

      else
         case Justify is
            when Left =>
               Target (Tfirst .. Tfirst + Slength - 1) := Source;

               for J in Tfirst + Slength .. Tlast loop
                  Target (J) := Pad;
               end loop;

            when Right =>
               for J in Tfirst .. Tlast - Slength loop
                  Target (J) := Pad;
               end loop;

               Target (Tlast - Slength + 1 .. Tlast) := Source;

            when Center =>
               declare
                  Front_Pad   : constant Integer := (Tlength - Slength) / 2;
                  Tfirst_Fpad : constant Integer := Tfirst + Front_Pad;

               begin
                  for J in Tfirst .. Tfirst_Fpad - 1 loop
                     Target (J) := Pad;
                  end loop;

                  Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source;

                  for J in Tfirst_Fpad + Slength .. Tlast loop
                     Target (J) := Pad;
                  end loop;
               end;
         end case;
      end if;
   end Move;

   ---------------
   -- Overwrite --
   ---------------

   function Overwrite
     (Source   : in Wide_String;
      Position : in Positive;
      New_Item : in Wide_String)
      return     Wide_String
   is
   begin
      if Position not in Source'First .. Source'Last + 1 then
         raise Index_Error;
      else
         declare
382
            Result_Length : constant Natural :=
383 384 385 386
                              Natural'Max
                                (Source'Length,
                                 Position - Source'First + New_Item'Length);

Richard Kenner committed
387 388 389 390
            Result : Wide_String (1 .. Result_Length);

         begin
            Result := Source (Source'First .. Position - 1) & New_Item &
391
                        Source (Position + New_Item'Length .. Source'Last);
Richard Kenner committed
392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590
            return Result;
         end;
      end if;
   end Overwrite;

   procedure Overwrite
     (Source   : in out Wide_String;
      Position : in Positive;
      New_Item : in Wide_String;
      Drop     : in Truncation := Right)
   is
   begin
      Move (Source => Overwrite (Source, Position, New_Item),
            Target => Source,
            Drop   => Drop);
   end Overwrite;

   -------------------
   -- Replace_Slice --
   -------------------

   function Replace_Slice
     (Source   : in Wide_String;
      Low      : in Positive;
      High     : in Natural;
      By       : in Wide_String)
      return     Wide_String
   is
      Result_Length : Natural;

   begin
      if Low > Source'Last + 1 or else High < Source'First - 1 then
         raise Index_Error;
      else
         Result_Length :=
           Source'Length - Natural'Max (High - Low + 1, 0) + By'Length;

         declare
            Result : Wide_String (1 .. Result_Length);

         begin
            if High >= Low then
               Result :=
                  Source (Source'First .. Low - 1) & By &
                  Source (High + 1 .. Source'Last);
            else
               Result := Source (Source'First .. Low - 1) & By &
                         Source (Low .. Source'Last);
            end if;

            return Result;
         end;
      end if;
   end Replace_Slice;

   procedure Replace_Slice
     (Source   : in out Wide_String;
      Low      : in Positive;
      High     : in Natural;
      By       : in Wide_String;
      Drop     : in Truncation := Error;
      Justify  : in Alignment  := Left;
      Pad      : in Wide_Character  := Wide_Space)
   is
   begin
      Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
   end Replace_Slice;

   ----------
   -- Tail --
   ----------

   function Tail
     (Source : in Wide_String;
      Count  : in Natural;
      Pad    : in Wide_Character := Wide_Space)
      return   Wide_String
   is
      Result : Wide_String (1 .. Count);

   begin
      if Count < Source'Length then
         Result := Source (Source'Last - Count + 1 .. Source'Last);

      --  Pad on left

      else
         for J in 1 .. Count - Source'Length loop
            Result (J) := Pad;
         end loop;

         Result (Count - Source'Length + 1 .. Count) := Source;
      end if;

      return Result;
   end Tail;

   procedure Tail
     (Source  : in out Wide_String;
      Count   : in Natural;
      Justify : in Alignment := Left;
      Pad     : in Wide_Character := Ada.Strings.Wide_Space)
   is
   begin
      Move (Source  => Tail (Source, Count, Pad),
            Target  => Source,
            Drop    => Error,
            Justify => Justify,
            Pad     => Pad);
   end Tail;

   ---------------
   -- Translate --
   ---------------

   function Translate
     (Source  : in Wide_String;
      Mapping : in Wide_Maps.Wide_Character_Mapping)
      return    Wide_String
   is
      Result : Wide_String (1 .. Source'Length);

   begin
      for J in Source'Range loop
         Result (J - (Source'First - 1)) := Value (Mapping, Source (J));
      end loop;

      return Result;
   end Translate;

   procedure Translate
     (Source  : in out Wide_String;
      Mapping : in Wide_Maps.Wide_Character_Mapping)
   is
   begin
      for J in Source'Range loop
         Source (J) := Value (Mapping, Source (J));
      end loop;
   end Translate;

   function Translate
     (Source  : in Wide_String;
      Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
      return    Wide_String
   is
      Result : Wide_String (1 .. Source'Length);

   begin
      for J in Source'Range loop
         Result (J - (Source'First - 1)) := Mapping (Source (J));
      end loop;

      return Result;
   end Translate;

   procedure Translate
     (Source  : in out Wide_String;
      Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
   is
   begin
      for J in Source'Range loop
         Source (J) := Mapping (Source (J));
      end loop;
   end Translate;

   ----------
   -- Trim --
   ----------

   function Trim
     (Source : in Wide_String;
      Side   : in Trim_End)
      return   Wide_String
   is
      Low  : Natural := Source'First;
      High : Natural := Source'Last;

   begin
      if Side = Left or else Side = Both then
         while Low <= High and then Source (Low) = Wide_Space loop
            Low := Low + 1;
         end loop;
      end if;

      if Side = Right or else Side = Both then
         while High >= Low and then Source (High) = Wide_Space loop
            High := High - 1;
         end loop;
      end if;

      --  All blanks case

      if Low > High then
         return "";

      --  At least one non-blank

      else
         declare
591 592
            Result : constant Wide_String (1 .. High - Low + 1) :=
                       Source (Low .. High);
Richard Kenner committed
593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659

         begin
            return Result;
         end;
      end if;
   end Trim;

   procedure Trim
     (Source  : in out Wide_String;
      Side    : in Trim_End;
      Justify : in Alignment      := Left;
      Pad     : in Wide_Character := Wide_Space)
   is
   begin
      Move (Source  => Trim (Source, Side),
            Target  => Source,
            Justify => Justify,
            Pad     => Pad);
   end Trim;

   function Trim
      (Source : in Wide_String;
       Left   : in Wide_Maps.Wide_Character_Set;
       Right  : in Wide_Maps.Wide_Character_Set)
       return   Wide_String
   is
      Low  : Natural := Source'First;
      High : Natural := Source'Last;

   begin
      while Low <= High and then Is_In (Source (Low), Left) loop
         Low := Low + 1;
      end loop;

      while High >= Low and then Is_In (Source (High), Right) loop
         High := High - 1;
      end loop;

      --  Case where source comprises only characters in the sets

      if Low > High then
         return "";
      else
         declare
            subtype WS is Wide_String (1 .. High - Low + 1);

         begin
            return WS (Source (Low .. High));
         end;
      end if;
   end Trim;

   procedure Trim
      (Source  : in out Wide_String;
       Left    : in Wide_Maps.Wide_Character_Set;
       Right   : in Wide_Maps.Wide_Character_Set;
       Justify : in Alignment      := Strings.Left;
       Pad     : in Wide_Character := Wide_Space)
   is
   begin
      Move (Source  => Trim (Source, Left, Right),
            Target  => Source,
            Justify => Justify,
            Pad     => Pad);
   end Trim;

end Ada.Strings.Wide_Fixed;