|
|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 8427 (0x20eb)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
with Random;
with Time_Utilities;
with Directory_Tools;
with String_Utilities;
with System_Utilities;
with Misc_String_Utilities;
package body Names is
Null_String : constant String := "";
Underscore : constant Character := '_';
Exclamation_Point : constant Character := '!';
function Is_Null (This_String : in String) return Boolean is
begin
return (This_String = Null_String);
end Is_Null;
function Is_Non_Null (This_String : in String) return Boolean is
begin
return (This_String /= Null_String);
end Is_Non_Null;
function Has_No_Leading_Underscore
(This_String : in String) return Boolean is
begin
return (This_String (This_String'First) /= Underscore);
end Has_No_Leading_Underscore;
function Has_No_Trailing_Underscore
(This_String : in String) return Boolean is
begin
return (This_String (This_String'Last) /= Underscore);
end Has_No_Trailing_Underscore;
function First_Character_Is_Letter
(The_String : in String) return Boolean is
begin
case (The_String (The_String'First)) is
when 'A' .. 'Z' | 'a' .. 'z' =>
return (True);
when others =>
return (False);
end case;
end First_Character_Is_Letter;
function Contains_No_Forbidden_Characters
(This_String : in String) return Boolean is
begin
for Index in This_String'First .. This_String'Last loop
case (This_String (Index)) is
when
Ascii.Nul .. '/' |
':' .. '@' |
'[' .. '^' |
'{' .. Ascii.Del |
'`' =>
return (False);
when others =>
null;
end case;
end loop;
return (True);
end Contains_No_Forbidden_Characters;
function Contains_No_Double_Underscores
(This_String : in String) return Boolean is
--
Found_Underscore : Boolean := False;
--
begin
for Index in This_String'First .. This_String'Last loop
if (This_String (Index) = Underscore) then
if (Found_Underscore) then
return (False);
else
Found_Underscore := True;
end if;
else
Found_Underscore := False;
end if;
return (True);
end loop;
end Contains_No_Double_Underscores;
function Is_Simple_Ada_Name (This_String : in String) return Boolean is
begin
if ((Is_Non_Null (This_String)) and then
(Has_No_Leading_Underscore (This_String)) and then
(Has_No_Trailing_Underscore (This_String)) and then
(First_Character_Is_Letter (This_String)) and then
(Contains_No_Forbidden_Characters (This_String)) and then
(Contains_No_Double_Underscores (This_String))) then
return (True);
else
return (False);
end if;
--
exception
when others =>
return (False);
--
end Is_Simple_Ada_Name;
function Is_Dotted_Ada_Name (This_String : in String) return Boolean is
--
Dot : constant Character := '.';
--
Start_Of_Segment : Integer := This_String'First;
End_Of_Segment : Integer := This_String'First;
--
begin
loop
while ((End_Of_Segment <= This_String'Last) and then
(This_String (End_Of_Segment) /= Dot)) loop
End_Of_Segment := End_Of_Segment + 1;
end loop;
if (not Names.Is_Simple_Ada_Name
(This_String (Start_Of_Segment ..
(End_Of_Segment - 1)))) then
return (False);
else
Start_Of_Segment := End_Of_Segment + 1;
End_Of_Segment := End_Of_Segment + 1;
if (Start_Of_Segment > This_String'Last) then
return (True);
end if;
end if;
end loop;
--
exception
when others =>
return (False);
--
end Is_Dotted_Ada_Name;
function Is_Ada_Name (This_String : in String) return Boolean is
begin
return ((Is_Simple_Ada_Name (This_String)) or else
(Is_Dotted_Ada_Name (This_String)));
end Is_Ada_Name;
function Is_Pathname (This_String : in String) return Boolean is
begin
if (This_String /= Misc_String_Utilities.Continuous (This_String)) then
return (False);
end if;
if (Is_Null (This_String)) then
return (False);
end if;
if (not Directory_Tools.Naming.Is_Well_Formed (This_String)) then
return (False);
end if;
return (True);
--
exception
when others =>
return (False);
--
end Is_Pathname;
function First_Character_Is_Not_Exclamation_Point
(This_String : in String) return Boolean is
begin
return (This_String (This_String'First) /= Exclamation_Point);
end First_Character_Is_Not_Exclamation_Point;
function Is_Fully_Qualified_Pathname
(This_String : in String) return Boolean is
begin
if (Is_Null (This_String)) then
return (False);
end if;
if (First_Character_Is_Not_Exclamation_Point (This_String)) then
return (False);
end if;
return (Is_Dotted_Ada_Name
(This_String ((This_String'First + 1) .. This_String'Last)));
--
exception
when others =>
return (False);
--
end Is_Fully_Qualified_Pathname;
function Is_User_Name (This_String : in String) return Boolean is
begin
return (Is_Simple_Ada_Name (This_String));
end Is_User_Name;
function Random_Number_Image return String is
--
Random_Handle : Random.Handle;
--
Random_Number : Natural;
--
begin
Random.Initialize (Random_Handle);
Random_Number := Random.Natural_Value
(Random_Handle, Max => Natural'Last);
return (String_Utilities.Strip (Natural'Image (Random_Number)));
end Random_Number_Image;
function Unique_Temporary_File_Name return String is
--
Prefix : constant String := "!MACHINE.TEMPORARY.UNIQUE_TEMPORARY_FILE_";
--
User_Name : constant String := System_Utilities.User_Name;
--
Session_Name : constant String := System_Utilities.Session_Name;
--
Time_Stamp : constant String := Time_Utilities.Image
(Date => Time_Utilities.Get_Time,
Date_Style => Time_Utilities.Ada,
Time_Style => Time_Utilities.Ada,
Contents => Time_Utilities.Both);
--
begin
return (Prefix & User_Name & "_" & Session_Name &
"_" & Time_Stamp & "_" & Random_Number_Image);
end Unique_Temporary_File_Name;
function Indirect_File_Name_For
(This_File_Name : in String) return String is
begin
return ("_" & String_Utilities.Upper_Case (This_File_Name));
end Indirect_File_Name_For;
function All_Objects_In (This_Library : in String;
Include_Object_Itself : in Boolean;
Transitive : in Boolean) return String is
begin
if (Transitive) then
if (Include_Object_Itself) then
return (String_Utilities.Upper_Case (This_Library) & "??");
else
return (String_Utilities.Upper_Case (This_Library) & ".@??");
end if;
else
if (Include_Object_Itself) then
return ("[" & String_Utilities.Upper_Case (This_Library) & "," &
String_Utilities.Upper_Case (This_Library) & ".@]");
else
return (String_Utilities.Upper_Case (This_Library) & ".@");
end if;
end if;
end All_Objects_In;
end Names;