|
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: 7653 (0x1de5)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦bb25a46d4⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦bb25a46d4⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦bb25a46d4⟧
└─⟦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;