home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Geek Gadgets 1
/
ADE-1.bin
/
ade-dist
/
gnat-2.06-src.tgz
/
tar.out
/
fsf
/
gnat
/
ada
/
a-stwifi.adb
< prev
next >
Wrap
Text File
|
1996-09-28
|
17KB
|
614 lines
------------------------------------------------------------------------------
-- --
-- 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 --
-- --
-- $Revision: 1.10 $ --
-- --
-- Copyright (c) 1992,1993,1994 NYU, All Rights Reserved --
-- --
-- The GNAT library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU Library General Public License as published by --
-- the Free Software Foundation; either version 2, or (at your option) any --
-- later version. The GNAT library is distributed in the hope that it will --
-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty --
-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- Library General Public License for more details. You should have --
-- received a copy of the GNU Library General Public License along with --
-- the GNAT library; see the file COPYING.LIB. If not, write to the Free --
-- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
-- --
------------------------------------------------------------------------------
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 > Through then
return Source;
elsif From > Source'Last + 1 or else Through < Source'First - 1 then
raise Index_Error;
else
declare
Result : constant Wide_String :=
Source (Source'First .. From - 1) &
Source (Through + 1 .. Source'Last);
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;
------------
-- 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
Result_Length : Natural :=
Natural'Max (Source'Length,
Position - Source'First + New_Item'Length);
Result : Wide_String (1 .. Result_Length);
begin
Result := Source (Source'First .. Position - 1) & New_Item &
Source (Position + New_Item'Length .. Source'Last);
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;
---------------
-- 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
Result : Wide_String (1 .. High - Low + 1) := Source (Low .. High);
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
Result : Wide_String (1 .. High - Low + 1) := Source (Low .. High);
begin
return Result;
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;
