|
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 - downloadIndex: ┃ B T ┃
Length: 8031 (0x1f5f)
Types: TextFile
Names: »B«
└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
└─ ⟦124ff5788⟧ »DATA«
└─⟦this⟧
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦this⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦this⟧
with Io_Exceptions;
with Logger;
with Requirements;
with String_Utilities;
separate (Actions)
package body Requirement is
package Dcp renames Directory.Control_Point;
package Diio renames Device_Independent_Io;
package Dna renames Directory.Naming;
package Gwo renames Gateway_Object;
function Formatted_Image
(R : in Requirements.Requirement_Kind) return String is
Capitalize_Next : Boolean := True;
Offset : constant := Character'Pos ('a') - Character'Pos ('A');
The_Image : constant String := Requirements.Requirement_Kind'Image (R);
The_Formatted_Image : String (The_Image'Range);
begin
for I in The_Image'Range loop
if The_Image (I) = '_' then
The_Formatted_Image (I) := ' ';
Capitalize_Next := True;
elsif Capitalize_Next then
The_Formatted_Image (I) := The_Image (I);
Capitalize_Next := False;
else
The_Formatted_Image (I) :=
Character'Val (Character'Pos (The_Image (I)) + Offset);
end if;
end loop;
return The_Formatted_Image;
end Formatted_Image;
function Image_Contents (Image : in Dc.Image_Id;
Contents_Before : in String;
First_Line_To_Examine : in Positive;
Last_Line_To_Examine : in Natural) return String is
begin
if First_Line_To_Examine > Last_Line_To_Examine then
return Contents_Before;
else
return Image_Contents
(Image => Image,
Contents_Before =>
Contents_Before & Ascii.Lf &
Dc.Line_Contents
(Id => Image, Line => First_Line_To_Examine),
First_Line_To_Examine => First_Line_To_Examine + 1,
Last_Line_To_Examine => Last_Line_To_Examine);
end if;
end Image_Contents;
function Image_Contents (Image : in Dc.Image_Id)
return String is
Last_Line : Natural := Dc.Last_Line (Image);
begin
if Last_Line = 0 then
return "";
else
return Image_Contents (Image => Image,
Contents_Before =>
Dc.Line_Contents (Id => Image, Line => 1),
First_Line_To_Examine => 2,
Last_Line_To_Examine => Last_Line);
end if;
end Image_Contents;
function Relative_Name (Full_Name : in String; Relative_To : in String)
return String is
begin
pragma Assert (Full_Name'Length >= Relative_To'Length and then
Full_Name (Full_Name'First ..
Full_Name'First + Relative_To'Length - 1) =
Relative_To);
return Full_Name
(Full_Name'First + Relative_To'Length + 1 -- Skip the '.'
.. Full_Name'Last);
end Relative_Name;
procedure Image_Name (Handle : Dc.Gateway_Handle;
Visible : Boolean;
Read_Only : Boolean;
No_Image : out Boolean;
Show_Property_Image : out Boolean;
Id : out Dc.Image_Identity) is
Gateway_Object : constant Dir.Object := Gwo.Directory_Object (Handle);
S : Ss.Condition;
begin
Show_Property_Image := False;
Id := (I1 => Dir.Unique (Gateway_Object), I2 => 0);
No_Image := False;
if not Read_Only then
S := Check_Writeable (Handle);
Logger.Status (S);
end if;
exception
when Profile.Error =>
No_Image := True;
Logger.Error ("Image construction is quitting after errors",
Raise_Error => False);
end Image_Name;
procedure Build_Image (Handle : Dc.Gateway_Handle;
Visible : Boolean;
In_Place : Boolean;
First_Time : Boolean;
Read_Only : in out Boolean;
Image : Dc.Image_Id;
No_Image : out Boolean;
Underlying_Object : out Directory.Object) is
E : Dir.Error_Status;
Gateway_Object : constant Dir.Object := Gwo.Directory_Object (Handle);
Gateway_Full_Name : constant String :=
Dna.Get_Full_Name (Gateway_Object);
Parent_Library : Dir.Object;
begin
Underlying_Object := Dir.Nil;
if not Read_Only then
if Ss.Error (Check_Writeable (Handle)) then
No_Image := True;
return;
end if;
end if;
Dcp.Parent_Library (The_Object => Gateway_Object,
The_Library => Parent_Library,
Status => E);
Logger.Status (E);
Dc.Replace_Header
(Image => Image,
Header => String_Utilities.Capitalize
(Relative_Name (Full_Name => Gateway_Full_Name,
Relative_To => Dna.Get_Full_Name
(Parent_Library))) &
" : " & Formatted_Image
(Asap.Asa_Requirement_Kind (Handle)) & ';');
Dc.Replace_Lines (Image => Image,
Starting_Line => 1,
Number_Of_Lines => Dc.Last_Line (Image),
New_Text => Asap.Asa_Requirement_Text (Handle));
No_Image := False;
exception
when Profile.Error =>
No_Image := True;
Logger.Error ("Image construction is quitting after errors",
Raise_Error => False);
end Build_Image;
procedure Post_Commit (Handle : Dc.Gateway_Handle;
Image : Dc.Image_Id) is
S : Ss.Condition;
The_Handle : Dc.Gateway_Handle := Handle;
begin
if not Gwo.Is_Main_Object_Open_For_Update (Handle) then
Gwo.Re_Open_Main_Object_For_Update (The_Handle, Errors => S);
Logger.Status (S);
end if;
Asap.Set_Asa_Requirement_Text (The_Handle,
Value => Image_Contents (Image));
exception
when Profile.Error =>
Logger.Error ("Image has not been committed", Raise_Error => False);
end Post_Commit;
procedure Edit (Handle : Dc.Gateway_Handle;
Image : Dc.Image_Id;
S : Dc.Selection;
C : Dc.Cursor;
Visible : Boolean;
Allow_Edit : out Boolean) is
St : Ss.Condition;
begin
St := Check_Writeable (Handle);
Logger.Status (St);
Allow_Edit := True;
exception
when Profile.Error =>
Allow_Edit := False;
Logger.Error ("Edit is quitting after errors",
Raise_Error => False);
end Edit;
procedure Io_Open (File : in out Device_Independent_Io.File_Type;
Mode : Device_Independent_Io.File_Mode;
Handle : Dc.Gateway_Handle;
Form : String;
Action_Id : Action.Id) is
use Diio;
begin
pragma Assert (Mode = Diio.In_File);
Diio.Create (File,
Mode => Diio.Out_File,
Name => "",
Action_Id => Action_Id);
Diio.Write (File,
Item => Asap.Asa_Requirement_Text (Handle));
Diio.Reset (File,
Mode => Diio.In_File);
end Io_Open;
end Requirement;