|
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 - metrics - download
Length: 10240 (0x2800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Requirement, seg_010757, separate Actions
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦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;
nblk1=9
nid=0
hdr6=12
[0x00] rec0=1b rec1=00 rec2=01 rec3=046
[0x01] rec0=17 rec1=00 rec2=02 rec3=072
[0x02] rec0=18 rec1=00 rec2=03 rec3=062
[0x03] rec0=19 rec1=00 rec2=04 rec3=01e
[0x04] rec0=18 rec1=00 rec2=05 rec3=016
[0x05] rec0=16 rec1=00 rec2=06 rec3=040
[0x06] rec0=19 rec1=00 rec2=07 rec3=03a
[0x07] rec0=1b rec1=00 rec2=08 rec3=048
[0x08] rec0=0a rec1=00 rec2=09 rec3=000
tail 0x2170c8a7a823076c246a2 0x42a00088462060003