------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
-- --
|
-- --
|
-- GNAT RUN-TIME COMPONENTS --
|
-- GNAT RUN-TIME COMPONENTS --
|
-- --
|
-- --
|
-- A D A . S T R I N G S . W I D E _ F I X E D --
|
-- A D A . S T R I N G S . W I D E _ F I X E D --
|
-- --
|
-- --
|
-- B o d y --
|
-- B o d y --
|
-- --
|
-- --
|
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
-- --
|
-- --
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
-- or FITNESS FOR A PARTICULAR PURPOSE. --
|
-- or FITNESS FOR A PARTICULAR PURPOSE. --
|
-- --
|
-- --
|
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
-- additional permissions described in the GCC Runtime Library Exception, --
|
-- additional permissions described in the GCC Runtime Library Exception, --
|
-- version 3.1, as published by the Free Software Foundation. --
|
-- version 3.1, as published by the Free Software Foundation. --
|
-- --
|
-- --
|
-- You should have received a copy of the GNU General Public License and --
|
-- You should have received a copy of the GNU General Public License and --
|
-- a copy of the GCC Runtime Library Exception along with this program; --
|
-- a copy of the GCC Runtime Library Exception along with this program; --
|
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
-- <http://www.gnu.org/licenses/>. --
|
-- <http://www.gnu.org/licenses/>. --
|
-- --
|
-- --
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
-- --
|
-- --
|
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
|
|
with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;
|
with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;
|
with Ada.Strings.Wide_Search;
|
with Ada.Strings.Wide_Search;
|
|
|
package body Ada.Strings.Wide_Fixed is
|
package body Ada.Strings.Wide_Fixed is
|
|
|
------------------------
|
------------------------
|
-- Search Subprograms --
|
-- Search Subprograms --
|
------------------------
|
------------------------
|
|
|
function Index
|
function Index
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Pattern : Wide_String;
|
Pattern : Wide_String;
|
Going : Direction := Forward;
|
Going : Direction := Forward;
|
Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
|
Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
|
return Natural
|
return Natural
|
renames Ada.Strings.Wide_Search.Index;
|
renames Ada.Strings.Wide_Search.Index;
|
|
|
function Index
|
function Index
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Pattern : Wide_String;
|
Pattern : Wide_String;
|
Going : Direction := Forward;
|
Going : Direction := Forward;
|
Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
|
Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
|
renames Ada.Strings.Wide_Search.Index;
|
renames Ada.Strings.Wide_Search.Index;
|
|
|
function Index
|
function Index
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Set : Wide_Maps.Wide_Character_Set;
|
Set : Wide_Maps.Wide_Character_Set;
|
Test : Membership := Inside;
|
Test : Membership := Inside;
|
Going : Direction := Forward) return Natural
|
Going : Direction := Forward) return Natural
|
renames Ada.Strings.Wide_Search.Index;
|
renames Ada.Strings.Wide_Search.Index;
|
|
|
function Index
|
function Index
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Pattern : Wide_String;
|
Pattern : Wide_String;
|
From : Positive;
|
From : Positive;
|
Going : Direction := Forward;
|
Going : Direction := Forward;
|
Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
|
Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
|
return Natural
|
return Natural
|
renames Ada.Strings.Wide_Search.Index;
|
renames Ada.Strings.Wide_Search.Index;
|
|
|
function Index
|
function Index
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Pattern : Wide_String;
|
Pattern : Wide_String;
|
From : Positive;
|
From : Positive;
|
Going : Direction := Forward;
|
Going : Direction := Forward;
|
Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
|
Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
|
renames Ada.Strings.Wide_Search.Index;
|
renames Ada.Strings.Wide_Search.Index;
|
|
|
function Index
|
function Index
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Set : Wide_Maps.Wide_Character_Set;
|
Set : Wide_Maps.Wide_Character_Set;
|
From : Positive;
|
From : Positive;
|
Test : Membership := Inside;
|
Test : Membership := Inside;
|
Going : Direction := Forward) return Natural
|
Going : Direction := Forward) return Natural
|
renames Ada.Strings.Wide_Search.Index;
|
renames Ada.Strings.Wide_Search.Index;
|
|
|
function Index_Non_Blank
|
function Index_Non_Blank
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Going : Direction := Forward) return Natural
|
Going : Direction := Forward) return Natural
|
renames Ada.Strings.Wide_Search.Index_Non_Blank;
|
renames Ada.Strings.Wide_Search.Index_Non_Blank;
|
|
|
function Index_Non_Blank
|
function Index_Non_Blank
|
(Source : Wide_String;
|
(Source : Wide_String;
|
From : Positive;
|
From : Positive;
|
Going : Direction := Forward) return Natural
|
Going : Direction := Forward) return Natural
|
renames Ada.Strings.Wide_Search.Index_Non_Blank;
|
renames Ada.Strings.Wide_Search.Index_Non_Blank;
|
|
|
function Count
|
function Count
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Pattern : Wide_String;
|
Pattern : Wide_String;
|
Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
|
Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
|
return Natural
|
return Natural
|
renames Ada.Strings.Wide_Search.Count;
|
renames Ada.Strings.Wide_Search.Count;
|
|
|
function Count
|
function Count
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Pattern : Wide_String;
|
Pattern : Wide_String;
|
Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
|
Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
|
renames Ada.Strings.Wide_Search.Count;
|
renames Ada.Strings.Wide_Search.Count;
|
|
|
function Count
|
function Count
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Set : Wide_Maps.Wide_Character_Set) return Natural
|
Set : Wide_Maps.Wide_Character_Set) return Natural
|
renames Ada.Strings.Wide_Search.Count;
|
renames Ada.Strings.Wide_Search.Count;
|
|
|
procedure Find_Token
|
procedure Find_Token
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Set : Wide_Maps.Wide_Character_Set;
|
Set : Wide_Maps.Wide_Character_Set;
|
Test : Membership;
|
Test : Membership;
|
First : out Positive;
|
First : out Positive;
|
Last : out Natural)
|
Last : out Natural)
|
renames Ada.Strings.Wide_Search.Find_Token;
|
renames Ada.Strings.Wide_Search.Find_Token;
|
|
|
---------
|
---------
|
-- "*" --
|
-- "*" --
|
---------
|
---------
|
|
|
function "*"
|
function "*"
|
(Left : Natural;
|
(Left : Natural;
|
Right : Wide_Character) return Wide_String
|
Right : Wide_Character) return Wide_String
|
is
|
is
|
Result : Wide_String (1 .. Left);
|
Result : Wide_String (1 .. Left);
|
|
|
begin
|
begin
|
for J in Result'Range loop
|
for J in Result'Range loop
|
Result (J) := Right;
|
Result (J) := Right;
|
end loop;
|
end loop;
|
|
|
return Result;
|
return Result;
|
end "*";
|
end "*";
|
|
|
function "*"
|
function "*"
|
(Left : Natural;
|
(Left : Natural;
|
Right : Wide_String) return Wide_String
|
Right : Wide_String) return Wide_String
|
is
|
is
|
Result : Wide_String (1 .. Left * Right'Length);
|
Result : Wide_String (1 .. Left * Right'Length);
|
Ptr : Integer := 1;
|
Ptr : Integer := 1;
|
|
|
begin
|
begin
|
for J in 1 .. Left loop
|
for J in 1 .. Left loop
|
Result (Ptr .. Ptr + Right'Length - 1) := Right;
|
Result (Ptr .. Ptr + Right'Length - 1) := Right;
|
Ptr := Ptr + Right'Length;
|
Ptr := Ptr + Right'Length;
|
end loop;
|
end loop;
|
|
|
return Result;
|
return Result;
|
end "*";
|
end "*";
|
|
|
------------
|
------------
|
-- Delete --
|
-- Delete --
|
------------
|
------------
|
|
|
function Delete
|
function Delete
|
(Source : Wide_String;
|
(Source : Wide_String;
|
From : Positive;
|
From : Positive;
|
Through : Natural) return Wide_String
|
Through : Natural) return Wide_String
|
is
|
is
|
begin
|
begin
|
if From not in Source'Range
|
if From not in Source'Range
|
or else Through > Source'Last
|
or else Through > Source'Last
|
then
|
then
|
raise Index_Error;
|
raise Index_Error;
|
|
|
elsif From > Through then
|
elsif From > Through then
|
return Source;
|
return Source;
|
|
|
else
|
else
|
declare
|
declare
|
Len : constant Integer := Source'Length - (Through - From + 1);
|
Len : constant Integer := Source'Length - (Through - From + 1);
|
Result : constant
|
Result : constant
|
Wide_String (Source'First .. Source'First + Len - 1) :=
|
Wide_String (Source'First .. Source'First + Len - 1) :=
|
Source (Source'First .. From - 1) &
|
Source (Source'First .. From - 1) &
|
Source (Through + 1 .. Source'Last);
|
Source (Through + 1 .. Source'Last);
|
begin
|
begin
|
return Result;
|
return Result;
|
end;
|
end;
|
end if;
|
end if;
|
end Delete;
|
end Delete;
|
|
|
procedure Delete
|
procedure Delete
|
(Source : in out Wide_String;
|
(Source : in out Wide_String;
|
From : Positive;
|
From : Positive;
|
Through : Natural;
|
Through : Natural;
|
Justify : Alignment := Left;
|
Justify : Alignment := Left;
|
Pad : Wide_Character := Wide_Space)
|
Pad : Wide_Character := Wide_Space)
|
is
|
is
|
begin
|
begin
|
Move (Source => Delete (Source, From, Through),
|
Move (Source => Delete (Source, From, Through),
|
Target => Source,
|
Target => Source,
|
Justify => Justify,
|
Justify => Justify,
|
Pad => Pad);
|
Pad => Pad);
|
end Delete;
|
end Delete;
|
|
|
----------
|
----------
|
-- Head --
|
-- Head --
|
----------
|
----------
|
|
|
function Head
|
function Head
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Count : Natural;
|
Count : Natural;
|
Pad : Wide_Character := Wide_Space) return Wide_String
|
Pad : Wide_Character := Wide_Space) return Wide_String
|
is
|
is
|
Result : Wide_String (1 .. Count);
|
Result : Wide_String (1 .. Count);
|
|
|
begin
|
begin
|
if Count <= Source'Length then
|
if Count <= Source'Length then
|
Result := Source (Source'First .. Source'First + Count - 1);
|
Result := Source (Source'First .. Source'First + Count - 1);
|
|
|
else
|
else
|
Result (1 .. Source'Length) := Source;
|
Result (1 .. Source'Length) := Source;
|
|
|
for J in Source'Length + 1 .. Count loop
|
for J in Source'Length + 1 .. Count loop
|
Result (J) := Pad;
|
Result (J) := Pad;
|
end loop;
|
end loop;
|
end if;
|
end if;
|
|
|
return Result;
|
return Result;
|
end Head;
|
end Head;
|
|
|
procedure Head
|
procedure Head
|
(Source : in out Wide_String;
|
(Source : in out Wide_String;
|
Count : Natural;
|
Count : Natural;
|
Justify : Alignment := Left;
|
Justify : Alignment := Left;
|
Pad : Wide_Character := Ada.Strings.Wide_Space)
|
Pad : Wide_Character := Ada.Strings.Wide_Space)
|
is
|
is
|
begin
|
begin
|
Move (Source => Head (Source, Count, Pad),
|
Move (Source => Head (Source, Count, Pad),
|
Target => Source,
|
Target => Source,
|
Drop => Error,
|
Drop => Error,
|
Justify => Justify,
|
Justify => Justify,
|
Pad => Pad);
|
Pad => Pad);
|
end Head;
|
end Head;
|
|
|
------------
|
------------
|
-- Insert --
|
-- Insert --
|
------------
|
------------
|
|
|
function Insert
|
function Insert
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Before : Positive;
|
Before : Positive;
|
New_Item : Wide_String) return Wide_String
|
New_Item : Wide_String) return Wide_String
|
is
|
is
|
Result : Wide_String (1 .. Source'Length + New_Item'Length);
|
Result : Wide_String (1 .. Source'Length + New_Item'Length);
|
|
|
begin
|
begin
|
if Before < Source'First or else Before > Source'Last + 1 then
|
if Before < Source'First or else Before > Source'Last + 1 then
|
raise Index_Error;
|
raise Index_Error;
|
end if;
|
end if;
|
|
|
Result := Source (Source'First .. Before - 1) & New_Item &
|
Result := Source (Source'First .. Before - 1) & New_Item &
|
Source (Before .. Source'Last);
|
Source (Before .. Source'Last);
|
return Result;
|
return Result;
|
end Insert;
|
end Insert;
|
|
|
procedure Insert
|
procedure Insert
|
(Source : in out Wide_String;
|
(Source : in out Wide_String;
|
Before : Positive;
|
Before : Positive;
|
New_Item : Wide_String;
|
New_Item : Wide_String;
|
Drop : Truncation := Error)
|
Drop : Truncation := Error)
|
is
|
is
|
begin
|
begin
|
Move (Source => Insert (Source, Before, New_Item),
|
Move (Source => Insert (Source, Before, New_Item),
|
Target => Source,
|
Target => Source,
|
Drop => Drop);
|
Drop => Drop);
|
end Insert;
|
end Insert;
|
|
|
----------
|
----------
|
-- Move --
|
-- Move --
|
----------
|
----------
|
|
|
procedure Move
|
procedure Move
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Target : out Wide_String;
|
Target : out Wide_String;
|
Drop : Truncation := Error;
|
Drop : Truncation := Error;
|
Justify : Alignment := Left;
|
Justify : Alignment := Left;
|
Pad : Wide_Character := Wide_Space)
|
Pad : Wide_Character := Wide_Space)
|
is
|
is
|
Sfirst : constant Integer := Source'First;
|
Sfirst : constant Integer := Source'First;
|
Slast : constant Integer := Source'Last;
|
Slast : constant Integer := Source'Last;
|
Slength : constant Integer := Source'Length;
|
Slength : constant Integer := Source'Length;
|
|
|
Tfirst : constant Integer := Target'First;
|
Tfirst : constant Integer := Target'First;
|
Tlast : constant Integer := Target'Last;
|
Tlast : constant Integer := Target'Last;
|
Tlength : constant Integer := Target'Length;
|
Tlength : constant Integer := Target'Length;
|
|
|
function Is_Padding (Item : Wide_String) return Boolean;
|
function Is_Padding (Item : Wide_String) return Boolean;
|
-- Determine if all characters in Item are pad characters
|
-- Determine if all characters in Item are pad characters
|
|
|
----------------
|
----------------
|
-- Is_Padding --
|
-- Is_Padding --
|
----------------
|
----------------
|
|
|
function Is_Padding (Item : Wide_String) return Boolean is
|
function Is_Padding (Item : Wide_String) return Boolean is
|
begin
|
begin
|
for J in Item'Range loop
|
for J in Item'Range loop
|
if Item (J) /= Pad then
|
if Item (J) /= Pad then
|
return False;
|
return False;
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
return True;
|
return True;
|
end Is_Padding;
|
end Is_Padding;
|
|
|
-- Start of processing for Move
|
-- Start of processing for Move
|
|
|
begin
|
begin
|
if Slength = Tlength then
|
if Slength = Tlength then
|
Target := Source;
|
Target := Source;
|
|
|
elsif Slength > Tlength then
|
elsif Slength > Tlength then
|
|
|
case Drop is
|
case Drop is
|
when Left =>
|
when Left =>
|
Target := Source (Slast - Tlength + 1 .. Slast);
|
Target := Source (Slast - Tlength + 1 .. Slast);
|
|
|
when Right =>
|
when Right =>
|
Target := Source (Sfirst .. Sfirst + Tlength - 1);
|
Target := Source (Sfirst .. Sfirst + Tlength - 1);
|
|
|
when Error =>
|
when Error =>
|
case Justify is
|
case Justify is
|
when Left =>
|
when Left =>
|
if Is_Padding (Source (Sfirst + Tlength .. Slast)) then
|
if Is_Padding (Source (Sfirst + Tlength .. Slast)) then
|
Target :=
|
Target :=
|
Source (Sfirst .. Sfirst + Target'Length - 1);
|
Source (Sfirst .. Sfirst + Target'Length - 1);
|
else
|
else
|
raise Length_Error;
|
raise Length_Error;
|
end if;
|
end if;
|
|
|
when Right =>
|
when Right =>
|
if Is_Padding (Source (Sfirst .. Slast - Tlength)) then
|
if Is_Padding (Source (Sfirst .. Slast - Tlength)) then
|
Target := Source (Slast - Tlength + 1 .. Slast);
|
Target := Source (Slast - Tlength + 1 .. Slast);
|
else
|
else
|
raise Length_Error;
|
raise Length_Error;
|
end if;
|
end if;
|
|
|
when Center =>
|
when Center =>
|
raise Length_Error;
|
raise Length_Error;
|
end case;
|
end case;
|
|
|
end case;
|
end case;
|
|
|
-- Source'Length < Target'Length
|
-- Source'Length < Target'Length
|
|
|
else
|
else
|
case Justify is
|
case Justify is
|
when Left =>
|
when Left =>
|
Target (Tfirst .. Tfirst + Slength - 1) := Source;
|
Target (Tfirst .. Tfirst + Slength - 1) := Source;
|
|
|
for J in Tfirst + Slength .. Tlast loop
|
for J in Tfirst + Slength .. Tlast loop
|
Target (J) := Pad;
|
Target (J) := Pad;
|
end loop;
|
end loop;
|
|
|
when Right =>
|
when Right =>
|
for J in Tfirst .. Tlast - Slength loop
|
for J in Tfirst .. Tlast - Slength loop
|
Target (J) := Pad;
|
Target (J) := Pad;
|
end loop;
|
end loop;
|
|
|
Target (Tlast - Slength + 1 .. Tlast) := Source;
|
Target (Tlast - Slength + 1 .. Tlast) := Source;
|
|
|
when Center =>
|
when Center =>
|
declare
|
declare
|
Front_Pad : constant Integer := (Tlength - Slength) / 2;
|
Front_Pad : constant Integer := (Tlength - Slength) / 2;
|
Tfirst_Fpad : constant Integer := Tfirst + Front_Pad;
|
Tfirst_Fpad : constant Integer := Tfirst + Front_Pad;
|
|
|
begin
|
begin
|
for J in Tfirst .. Tfirst_Fpad - 1 loop
|
for J in Tfirst .. Tfirst_Fpad - 1 loop
|
Target (J) := Pad;
|
Target (J) := Pad;
|
end loop;
|
end loop;
|
|
|
Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source;
|
Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source;
|
|
|
for J in Tfirst_Fpad + Slength .. Tlast loop
|
for J in Tfirst_Fpad + Slength .. Tlast loop
|
Target (J) := Pad;
|
Target (J) := Pad;
|
end loop;
|
end loop;
|
end;
|
end;
|
end case;
|
end case;
|
end if;
|
end if;
|
end Move;
|
end Move;
|
|
|
---------------
|
---------------
|
-- Overwrite --
|
-- Overwrite --
|
---------------
|
---------------
|
|
|
function Overwrite
|
function Overwrite
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Position : Positive;
|
Position : Positive;
|
New_Item : Wide_String) return Wide_String
|
New_Item : Wide_String) return Wide_String
|
is
|
is
|
begin
|
begin
|
if Position not in Source'First .. Source'Last + 1 then
|
if Position not in Source'First .. Source'Last + 1 then
|
raise Index_Error;
|
raise Index_Error;
|
else
|
else
|
declare
|
declare
|
Result_Length : constant Natural :=
|
Result_Length : constant Natural :=
|
Natural'Max
|
Natural'Max
|
(Source'Length,
|
(Source'Length,
|
Position - Source'First + New_Item'Length);
|
Position - Source'First + New_Item'Length);
|
|
|
Result : Wide_String (1 .. Result_Length);
|
Result : Wide_String (1 .. Result_Length);
|
|
|
begin
|
begin
|
Result := Source (Source'First .. Position - 1) & New_Item &
|
Result := Source (Source'First .. Position - 1) & New_Item &
|
Source (Position + New_Item'Length .. Source'Last);
|
Source (Position + New_Item'Length .. Source'Last);
|
return Result;
|
return Result;
|
end;
|
end;
|
end if;
|
end if;
|
end Overwrite;
|
end Overwrite;
|
|
|
procedure Overwrite
|
procedure Overwrite
|
(Source : in out Wide_String;
|
(Source : in out Wide_String;
|
Position : Positive;
|
Position : Positive;
|
New_Item : Wide_String;
|
New_Item : Wide_String;
|
Drop : Truncation := Right)
|
Drop : Truncation := Right)
|
is
|
is
|
begin
|
begin
|
Move (Source => Overwrite (Source, Position, New_Item),
|
Move (Source => Overwrite (Source, Position, New_Item),
|
Target => Source,
|
Target => Source,
|
Drop => Drop);
|
Drop => Drop);
|
end Overwrite;
|
end Overwrite;
|
|
|
-------------------
|
-------------------
|
-- Replace_Slice --
|
-- Replace_Slice --
|
-------------------
|
-------------------
|
|
|
function Replace_Slice
|
function Replace_Slice
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Low : Positive;
|
Low : Positive;
|
High : Natural;
|
High : Natural;
|
By : Wide_String) return Wide_String
|
By : Wide_String) return Wide_String
|
is
|
is
|
Result_Length : Natural;
|
Result_Length : Natural;
|
|
|
begin
|
begin
|
if Low > Source'Last + 1 or else High < Source'First - 1 then
|
if Low > Source'Last + 1 or else High < Source'First - 1 then
|
raise Index_Error;
|
raise Index_Error;
|
else
|
else
|
Result_Length :=
|
Result_Length :=
|
Source'Length - Natural'Max (High - Low + 1, 0) + By'Length;
|
Source'Length - Natural'Max (High - Low + 1, 0) + By'Length;
|
|
|
declare
|
declare
|
Result : Wide_String (1 .. Result_Length);
|
Result : Wide_String (1 .. Result_Length);
|
|
|
begin
|
begin
|
if High >= Low then
|
if High >= Low then
|
Result :=
|
Result :=
|
Source (Source'First .. Low - 1) & By &
|
Source (Source'First .. Low - 1) & By &
|
Source (High + 1 .. Source'Last);
|
Source (High + 1 .. Source'Last);
|
else
|
else
|
Result := Source (Source'First .. Low - 1) & By &
|
Result := Source (Source'First .. Low - 1) & By &
|
Source (Low .. Source'Last);
|
Source (Low .. Source'Last);
|
end if;
|
end if;
|
|
|
return Result;
|
return Result;
|
end;
|
end;
|
end if;
|
end if;
|
end Replace_Slice;
|
end Replace_Slice;
|
|
|
procedure Replace_Slice
|
procedure Replace_Slice
|
(Source : in out Wide_String;
|
(Source : in out Wide_String;
|
Low : Positive;
|
Low : Positive;
|
High : Natural;
|
High : Natural;
|
By : Wide_String;
|
By : Wide_String;
|
Drop : Truncation := Error;
|
Drop : Truncation := Error;
|
Justify : Alignment := Left;
|
Justify : Alignment := Left;
|
Pad : Wide_Character := Wide_Space)
|
Pad : Wide_Character := Wide_Space)
|
is
|
is
|
begin
|
begin
|
Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
|
Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
|
end Replace_Slice;
|
end Replace_Slice;
|
|
|
----------
|
----------
|
-- Tail --
|
-- Tail --
|
----------
|
----------
|
|
|
function Tail
|
function Tail
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Count : Natural;
|
Count : Natural;
|
Pad : Wide_Character := Wide_Space) return Wide_String
|
Pad : Wide_Character := Wide_Space) return Wide_String
|
is
|
is
|
Result : Wide_String (1 .. Count);
|
Result : Wide_String (1 .. Count);
|
|
|
begin
|
begin
|
if Count < Source'Length then
|
if Count < Source'Length then
|
Result := Source (Source'Last - Count + 1 .. Source'Last);
|
Result := Source (Source'Last - Count + 1 .. Source'Last);
|
|
|
-- Pad on left
|
-- Pad on left
|
|
|
else
|
else
|
for J in 1 .. Count - Source'Length loop
|
for J in 1 .. Count - Source'Length loop
|
Result (J) := Pad;
|
Result (J) := Pad;
|
end loop;
|
end loop;
|
|
|
Result (Count - Source'Length + 1 .. Count) := Source;
|
Result (Count - Source'Length + 1 .. Count) := Source;
|
end if;
|
end if;
|
|
|
return Result;
|
return Result;
|
end Tail;
|
end Tail;
|
|
|
procedure Tail
|
procedure Tail
|
(Source : in out Wide_String;
|
(Source : in out Wide_String;
|
Count : Natural;
|
Count : Natural;
|
Justify : Alignment := Left;
|
Justify : Alignment := Left;
|
Pad : Wide_Character := Ada.Strings.Wide_Space)
|
Pad : Wide_Character := Ada.Strings.Wide_Space)
|
is
|
is
|
begin
|
begin
|
Move (Source => Tail (Source, Count, Pad),
|
Move (Source => Tail (Source, Count, Pad),
|
Target => Source,
|
Target => Source,
|
Drop => Error,
|
Drop => Error,
|
Justify => Justify,
|
Justify => Justify,
|
Pad => Pad);
|
Pad => Pad);
|
end Tail;
|
end Tail;
|
|
|
---------------
|
---------------
|
-- Translate --
|
-- Translate --
|
---------------
|
---------------
|
|
|
function Translate
|
function Translate
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Mapping : Wide_Maps.Wide_Character_Mapping) return Wide_String
|
Mapping : Wide_Maps.Wide_Character_Mapping) return Wide_String
|
is
|
is
|
Result : Wide_String (1 .. Source'Length);
|
Result : Wide_String (1 .. Source'Length);
|
|
|
begin
|
begin
|
for J in Source'Range loop
|
for J in Source'Range loop
|
Result (J - (Source'First - 1)) := Value (Mapping, Source (J));
|
Result (J - (Source'First - 1)) := Value (Mapping, Source (J));
|
end loop;
|
end loop;
|
|
|
return Result;
|
return Result;
|
end Translate;
|
end Translate;
|
|
|
procedure Translate
|
procedure Translate
|
(Source : in out Wide_String;
|
(Source : in out Wide_String;
|
Mapping : Wide_Maps.Wide_Character_Mapping)
|
Mapping : Wide_Maps.Wide_Character_Mapping)
|
is
|
is
|
begin
|
begin
|
for J in Source'Range loop
|
for J in Source'Range loop
|
Source (J) := Value (Mapping, Source (J));
|
Source (J) := Value (Mapping, Source (J));
|
end loop;
|
end loop;
|
end Translate;
|
end Translate;
|
|
|
function Translate
|
function Translate
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Wide_String
|
Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Wide_String
|
is
|
is
|
Result : Wide_String (1 .. Source'Length);
|
Result : Wide_String (1 .. Source'Length);
|
|
|
begin
|
begin
|
for J in Source'Range loop
|
for J in Source'Range loop
|
Result (J - (Source'First - 1)) := Mapping (Source (J));
|
Result (J - (Source'First - 1)) := Mapping (Source (J));
|
end loop;
|
end loop;
|
|
|
return Result;
|
return Result;
|
end Translate;
|
end Translate;
|
|
|
procedure Translate
|
procedure Translate
|
(Source : in out Wide_String;
|
(Source : in out Wide_String;
|
Mapping : Wide_Maps.Wide_Character_Mapping_Function)
|
Mapping : Wide_Maps.Wide_Character_Mapping_Function)
|
is
|
is
|
begin
|
begin
|
for J in Source'Range loop
|
for J in Source'Range loop
|
Source (J) := Mapping (Source (J));
|
Source (J) := Mapping (Source (J));
|
end loop;
|
end loop;
|
end Translate;
|
end Translate;
|
|
|
----------
|
----------
|
-- Trim --
|
-- Trim --
|
----------
|
----------
|
|
|
function Trim
|
function Trim
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Side : Trim_End) return Wide_String
|
Side : Trim_End) return Wide_String
|
is
|
is
|
Low : Natural := Source'First;
|
Low : Natural := Source'First;
|
High : Natural := Source'Last;
|
High : Natural := Source'Last;
|
|
|
begin
|
begin
|
if Side = Left or else Side = Both then
|
if Side = Left or else Side = Both then
|
while Low <= High and then Source (Low) = Wide_Space loop
|
while Low <= High and then Source (Low) = Wide_Space loop
|
Low := Low + 1;
|
Low := Low + 1;
|
end loop;
|
end loop;
|
end if;
|
end if;
|
|
|
if Side = Right or else Side = Both then
|
if Side = Right or else Side = Both then
|
while High >= Low and then Source (High) = Wide_Space loop
|
while High >= Low and then Source (High) = Wide_Space loop
|
High := High - 1;
|
High := High - 1;
|
end loop;
|
end loop;
|
end if;
|
end if;
|
|
|
-- All blanks case
|
-- All blanks case
|
|
|
if Low > High then
|
if Low > High then
|
return "";
|
return "";
|
|
|
-- At least one non-blank
|
-- At least one non-blank
|
|
|
else
|
else
|
declare
|
declare
|
Result : constant Wide_String (1 .. High - Low + 1) :=
|
Result : constant Wide_String (1 .. High - Low + 1) :=
|
Source (Low .. High);
|
Source (Low .. High);
|
|
|
begin
|
begin
|
return Result;
|
return Result;
|
end;
|
end;
|
end if;
|
end if;
|
end Trim;
|
end Trim;
|
|
|
procedure Trim
|
procedure Trim
|
(Source : in out Wide_String;
|
(Source : in out Wide_String;
|
Side : Trim_End;
|
Side : Trim_End;
|
Justify : Alignment := Left;
|
Justify : Alignment := Left;
|
Pad : Wide_Character := Wide_Space)
|
Pad : Wide_Character := Wide_Space)
|
is
|
is
|
begin
|
begin
|
Move (Source => Trim (Source, Side),
|
Move (Source => Trim (Source, Side),
|
Target => Source,
|
Target => Source,
|
Justify => Justify,
|
Justify => Justify,
|
Pad => Pad);
|
Pad => Pad);
|
end Trim;
|
end Trim;
|
|
|
function Trim
|
function Trim
|
(Source : Wide_String;
|
(Source : Wide_String;
|
Left : Wide_Maps.Wide_Character_Set;
|
Left : Wide_Maps.Wide_Character_Set;
|
Right : Wide_Maps.Wide_Character_Set) return Wide_String
|
Right : Wide_Maps.Wide_Character_Set) return Wide_String
|
is
|
is
|
Low : Natural := Source'First;
|
Low : Natural := Source'First;
|
High : Natural := Source'Last;
|
High : Natural := Source'Last;
|
|
|
begin
|
begin
|
while Low <= High and then Is_In (Source (Low), Left) loop
|
while Low <= High and then Is_In (Source (Low), Left) loop
|
Low := Low + 1;
|
Low := Low + 1;
|
end loop;
|
end loop;
|
|
|
while High >= Low and then Is_In (Source (High), Right) loop
|
while High >= Low and then Is_In (Source (High), Right) loop
|
High := High - 1;
|
High := High - 1;
|
end loop;
|
end loop;
|
|
|
-- Case where source comprises only characters in the sets
|
-- Case where source comprises only characters in the sets
|
|
|
if Low > High then
|
if Low > High then
|
return "";
|
return "";
|
else
|
else
|
declare
|
declare
|
subtype WS is Wide_String (1 .. High - Low + 1);
|
subtype WS is Wide_String (1 .. High - Low + 1);
|
|
|
begin
|
begin
|
return WS (Source (Low .. High));
|
return WS (Source (Low .. High));
|
end;
|
end;
|
end if;
|
end if;
|
end Trim;
|
end Trim;
|
|
|
procedure Trim
|
procedure Trim
|
(Source : in out Wide_String;
|
(Source : in out Wide_String;
|
Left : Wide_Maps.Wide_Character_Set;
|
Left : Wide_Maps.Wide_Character_Set;
|
Right : Wide_Maps.Wide_Character_Set;
|
Right : Wide_Maps.Wide_Character_Set;
|
Justify : Alignment := Strings.Left;
|
Justify : Alignment := Strings.Left;
|
Pad : Wide_Character := Wide_Space)
|
Pad : Wide_Character := Wide_Space)
|
is
|
is
|
begin
|
begin
|
Move (Source => Trim (Source, Left, Right),
|
Move (Source => Trim (Source, Left, Right),
|
Target => Source,
|
Target => Source,
|
Justify => Justify,
|
Justify => Justify,
|
Pad => Pad);
|
Pad => Pad);
|
end Trim;
|
end Trim;
|
|
|
end Ada.Strings.Wide_Fixed;
|
end Ada.Strings.Wide_Fixed;
|
|
|
