|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 14336 (0x3800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body More_String_Utilities, seg_00469c
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with String_Utilities;
package body More_String_Utilities is
Blank : constant Character := ' ';
Tab : constant Character := Ascii.Ht;
function Begins_With
(Fragment : String; In_String : String) return Boolean is
Fragment_Length : constant Natural := Fragment'Length;
begin
if In_String = "" or else Fragment = "" then
return False;
elsif Fragment_Length > In_String'Length then
return False;
else
return In_String (In_String'First ..
In_String'First + Fragment_Length - 1) =
Fragment;
end if;
end Begins_With;
function Ends_With (Fragment : String; In_String : String) return Boolean is
Fragment_Length : constant Natural := Fragment'Length;
begin
if In_String = "" or else Fragment = "" then
return False;
elsif Fragment_Length > In_String'Length then
return False;
else
return In_String (In_String'Last - Fragment_Length + 1 ..
In_String'Last) = Fragment;
end if;
end Ends_With;
function Contains (Fragment : String; In_String : String) return Boolean is
begin
return String_Utilities.Locate (Fragment, In_String) > 0;
end Contains;
function Is_Blank (This_String : in String) return Boolean is
begin
for Index in This_String'Range loop
case This_String (Index) is
when Blank | Tab =>
null;
when others =>
return False;
end case;
end loop;
return True;
end Is_Blank;
function Is_Continuous (This_String : in String) return Boolean is
begin
for I in This_String'Range loop
if This_String (I) = Blank or else This_String (I) = Tab then
return False;
end if;
end loop;
return True;
end Is_Continuous;
function Is_Padded (This_String : in String) return Boolean is
begin
if This_String = "" then
return False;
else
declare
First : Character := This_String (This_String'First);
Last : Character := This_String (This_String'Last);
begin
return First = Blank or else Last = Blank or else
First = Tab or else Last = Tab;
end;
end if;
end Is_Padded;
function Equal (This_String : in String;
That_String : in String;
Ignore_Case : in Boolean) return Boolean is
begin
if Ignore_Case then
return String_Utilities.Upper_Case (This_String) =
String_Utilities.Upper_Case (That_String);
else
return This_String = That_String;
end if;
end Equal;
function Equal (This_Character : in Character;
That_Character : in Character;
Ignore_Case : in Boolean) return Boolean is
begin
if Ignore_Case then
return String_Utilities.Upper_Case (This_Character) =
String_Utilities.Upper_Case (That_Character);
else
return (This_Character = That_Character);
end if;
end Equal;
function Stripped (This_String : in String;
This_Character : in Character := ' ';
Ignore_Case : in Boolean := False) return String is
begin
if This_String = "" then
return This_String;
else
for Index in This_String'Range loop
if Equal
(This_String (Index), This_Character, Ignore_Case) then
return This_String (This_String'First .. Index - 1) &
Stripped (This_String
(Index + 1 .. This_String'Last),
This_Character, Ignore_Case);
end if;
end loop;
return This_String;
end if;
end Stripped;
function Stripped (This_String : in String;
This_Substring : in String;
Ignore_Case : in Boolean := False) return String is
Length : constant Natural := This_Substring'Length;
begin
if This_String = "" or else This_Substring = "" then
-- Is a no-op.
return This_String;
else
for Index in This_String'First .. This_String'Last - Length + 1 loop
if Equal
(This_String (Index .. Index + Length - 1),
This_Substring, Ignore_Case) then
return This_String (This_String'First .. Index - 1) &
Stripped (This_String
(Index + Length .. This_String'Last),
This_Substring, Ignore_Case);
end if;
end loop;
return This_String;
end if;
end Stripped;
function Replace (Character_At : in Positive;
With_Character : in Character;
In_String : in String) return String is
Preceeding_Stuff : constant String :=
In_String (In_String'First .. (Character_At - 1));
Following_Stuff : constant String :=
In_String ((Character_At + 1) .. In_String'Last);
New_String_Raw : constant String :=
Preceeding_Stuff & With_Character & Following_Stuff;
New_String_Normalized :
constant String (1 .. New_String_Raw'Length) := New_String_Raw;
begin
return New_String_Normalized;
end Replace;
function Replaced (This_String : in String;
Old_Character : in Character := '_';
New_Character : in Character := ' ';
Ignore_Case : in Boolean := False) return String is
begin
if This_String = "" then
return This_String;
else
for Index in This_String'Range loop
if Equal
(This_String (Index), Old_Character, Ignore_Case) then
return This_String (This_String'First .. Index - 1) &
New_Character &
Replaced (This_String
(Index + 1 .. This_String'Last),
Old_Character,
New_Character, Ignore_Case);
end if;
end loop;
return This_String;
end if;
end Replaced;
function Replace (From_Here : in Positive;
To_Here : in Positive;
With_Substring : in String;
In_String : in String) return String is
Preceeding_Stuff : constant String :=
In_String (In_String'First .. (From_Here - 1));
Following_Stuff : constant String :=
In_String ((To_Here + 1) .. In_String'Last);
New_String_Raw : constant String :=
Preceeding_Stuff & With_Substring & Following_Stuff;
New_String_Normalized :
constant String (1 .. New_String_Raw'Length) := New_String_Raw;
begin
return New_String_Normalized;
end Replace;
function Replaced (This_String : in String;
Old_Substring : in String;
New_Substring : in String;
Ignore_Case : in Boolean := False) return String is
Length : constant Natural := Old_Substring'Length;
begin
if This_String = "" or else Old_Substring = "" then
-- Is a no-op.
return This_String;
else
for Index in This_String'First .. This_String'Last - Length + 1 loop
if Equal
(This_String (Index .. Index + Length - 1),
Old_Substring, Ignore_Case) then
return This_String (This_String'First .. Index - 1) &
New_Substring &
Replaced (This_String
(Index + Length .. This_String'Last),
Old_Substring,
New_Substring, Ignore_Case);
end if;
end loop;
return This_String;
end if;
end Replaced;
end More_String_Utilities;
nblk1=d
nid=0
hdr6=1a
[0x00] rec0=20 rec1=00 rec2=01 rec3=04a
[0x01] rec0=00 rec1=00 rec2=0d rec3=004
[0x02] rec0=1f rec1=00 rec2=02 rec3=082
[0x03] rec0=1d rec1=00 rec2=03 rec3=01c
[0x04] rec0=1b rec1=00 rec2=04 rec3=018
[0x05] rec0=18 rec1=00 rec2=05 rec3=04a
[0x06] rec0=16 rec1=00 rec2=06 rec3=02e
[0x07] rec0=01 rec1=00 rec2=0c rec3=03e
[0x08] rec0=16 rec1=00 rec2=07 rec3=088
[0x09] rec0=1a rec1=00 rec2=08 rec3=062
[0x0a] rec0=01 rec1=00 rec2=0b rec3=050
[0x0b] rec0=16 rec1=00 rec2=09 rec3=03c
[0x0c] rec0=05 rec1=00 rec2=0a rec3=000
tail 0x2170029c8815c66a438a4 0x42a00088462061e03