|
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: ┃ T V ┃
Length: 32845 (0x804d)
Types: TextFile
Names: »V«
└─⟦d10a02448⟧ Bits:30000409 8mm tape, Rational 1000, ENVIRONMENT, D_12_7_3
└─ ⟦fc9b38f02⟧ »DATA«
└─⟦9b46a407a⟧
└─⟦12c68c704⟧
└─⟦this⟧
└─⟦5f3412b64⟧ Bits:30000745 8mm tape, Rational 1000, ENVIRONMENT 12_6_5 TOOLS
└─ ⟦91c658230⟧ »DATA«
└─⟦458657fb6⟧
└─⟦220843204⟧
└─⟦this⟧
with Action;
with Calendar;
with Default;
with Directory;
with Io;
with Machine;
with System;
with Work_Order_Errors;
package Work_Order_Implementation is
pragma Subsystem (Cmvc);
pragma Module_Name (4, 3780);
pragma Bias_Key (9);
subtype User_Id is Machine.Session_Id;
subtype Venture_Id is Directory.Object;
subtype Work_Order_Id is Directory.Object;
subtype Work_Order_List_Id is Directory.Object;
function Nil return Directory.Object renames Directory.Nil;
function Is_Nil (Id : Directory.Object) return Boolean
renames Directory.Is_Nil;
type Venture_Handle is private;
type Work_Order_Handle is private;
type Work_Order_List_Handle is private;
Null_Venture_Handle : constant Venture_Handle;
Null_Work_Order_Handle : constant Work_Order_Handle;
Null_Work_Order_List_Handle : constant Work_Order_List_Handle;
subtype Status is Work_Order_Errors.Status;
type Open_Mode is (None, Read, Update);
-- Types used in Fields.
type Venture_Field is private;
type Work_Order_Field is private;
Null_Venture_Field : constant Venture_Field;
Null_Work_Order_Field : constant Work_Order_Field;
type Field_Type_Enum is (Bool, Str, Int);
type Descriptor_Info_Record is
record
Element_Type : Field_Type_Enum; -- Elements have this type.
Is_Vector : Boolean; -- Are elements arrays?
end record;
-- A Venture is a Work Order Database created in a subsystem.
-- This subsystem can be at any level in the hierarchy
-- (see CMVC.Project_Hierarchy_Operations).
package Venture_Control is
procedure Find (Venture_Name : String;
Result : out Venture_Id;
Success : out Status);
--
-- Invoke name resolution on a string.
-- Returns bad status if the venture cannot be found.
procedure Create (Venture_Name : String;
The_Handle : out Venture_Handle;
Success : out Status;
Notes : String := "";
Storage : System.Segment := System.Null_Segment;
Action_Id : Action.Id := Action.Null_Id);
--
-- New venture will be open for Update.
procedure Open (The_Venture : Venture_Id;
The_Handle : out Venture_Handle;
Success : out Status;
Mode : Open_Mode := Read;
Storage : System.Segment := System.Null_Segment;
Action_Id : Action.Id := Action.Null_Id);
--
-- The_Venture may not be opened with mode None.
procedure Close (The_Handle : in out Venture_Handle;
Success : out Status);
--
-- The_Handle will be set to Null_Venture_Handle after closing.
function Id (The_Handle : Venture_Handle) return Venture_Id;
function Mode (The_Handle : Venture_Handle) return Open_Mode;
function Full_Name (The_Handle : Venture_Handle) return String;
-- These information functions may be used on any handle.
end Venture_Control;
package Venture_Operations is
procedure Set_Default (To : Venture_Id;
Success : out Status;
For_User : User_Id := Default.Session);
--
-- Set the appropriate session switch. To may be Nil.
procedure Get_Default (Result : out Venture_Id;
Success : out Status;
For_User : User_Id := Default.Session;
Ignore_Garbage : Boolean := True);
--
-- If Ignore_Garbage is True and the default venture no longer
-- exists, Nil will be returned instead.
function Require_Default_Venture return Boolean;
procedure Set_Require_Default_Venture
(To_Val : Boolean; Success : out Status);
--
-- System wide setting. Maybe this should be controlled?
type Policy_Switches_Enum is (Require_Current_Work_Order,
Require_Comment_At_Check_In,
Require_Comment_Lines,
Journal_Comment_Lines,
Allow_Edit_Of_Work_Orders);
type Policy_Switches is array (Policy_Switches_Enum) of Boolean;
procedure Get_Policy_Switch (Value : out Policy_Switches;
For_Venture : Venture_Handle;
Success : out Status);
procedure Set_Policy_Switch (To_Value : Policy_Switches;
For_Venture : Venture_Handle;
Success : out Status);
--
-- For_Venture must be writable before its policy may be changed.
function Get_Notes (For_Venture : Venture_Handle) return String;
--
-- Constraint_Error will be raised if the handle is not open.
procedure Set_Notes (To_Value : String;
For_Venture : Venture_Handle;
Success : out Status);
--
-- For_Venture must be writable before its notes may be changed.
procedure Count_Orders (For_Venture : Venture_Handle;
Work_Orders : out Natural;
Success : out Status);
generic
with procedure Visit (Value : Work_Order_Id);
procedure Traverse_Orders
(The_Venture : Venture_Handle; Success : out Status);
--
-- Do not Create or Delete Work_Orders while traversing.
procedure Count_Lists (For_Venture : Venture_Handle;
Work_Order_Lists : out Natural;
Success : out Status);
generic
with procedure Visit (Value : Work_Order_List_Id);
procedure Traverse_Lists
(The_Venture : Venture_Handle; Success : out Status);
--
-- Do not Create or Delete Work_Order_Lists while traversing.
procedure Count_Default_Orders (For_Venture : Venture_Handle;
Users : out Natural;
Success : out Status);
--
-- Returns the number of users who have ever set a default
-- work_order for this venture.
generic
with procedure Visit (The_User : User_Id; Value : Work_Order_Id);
procedure Traverse_Default_Orders
(The_Venture : Venture_Handle; Success : out Status);
--
-- Do not Set_Default Work_Orders while traversing.
procedure Count_Default_Lists (For_Venture : Venture_Handle;
Users : out Natural;
Success : out Status);
--
-- Returns the number of users who have ever set a default
-- work_order_list for this venture.
generic
with procedure Visit (The_User : User_Id;
Value : Work_Order_List_Id);
procedure Traverse_Default_Lists
(The_Venture : Venture_Handle; Success : out Status);
--
-- Do not Set_Default Work_Order_Lists while traversing.
end Venture_Operations;
package Venture_Field_Operations is
subtype Field is Venture_Field;
function Null_Field return Field;
type Modifiable_Info_Record is
record
Is_Controlled : Boolean;
Display_Position : Natural;
end record;
procedure Create (Field_Name : String;
Descriptor_Info : Descriptor_Info_Record;
Modifiable_Info : Modifiable_Info_Record;
Default : String;
Result : out Field;
Success : out Status;
For_Venture : Venture_Handle;
Propagate : Boolean := True);
--
-- Creates a new user-defined field in a venture.
-- Field names may not contain Ascii.Lf, '"', or " => ".
-- All fields will have a default value. If the Default string
-- cannot be parsed, a value of False or 0 will be assumed.
-- Creating a new field will not affect any existing Work_Orders.
-- For_Venture must be writable.
-- If Propagate is true, all existing work_orders will be
-- updated to have this new field.
procedure Delete (Field_Name : String;
Success : out Status;
In_Venture : Venture_Handle;
Even_If_Data_Present : Boolean := False);
--
-- Deletes the field from the venture.
-- If work orders exist that have data in the field, the
-- operation fails unless Even_If_Data_Present is true.
-- This can be a very time consuming operation, as it must
-- cycle through all of the work orders and remove the field.
-- Each Work_Order will be opened with the Venture's action_id.
-- In_Venture must be writable.
procedure Find (Field_Name : String;
The_Field : out Field;
Success : out Status;
In_Venture : Venture_Handle);
--
-- Search for the named field.
-- Returns Null_Field (and a warning) if Field_Name cannot be found.
-- Letter case and leading and trailing spaces are ignored.
function Modifiable_Info (The_Field : Field)
return Modifiable_Info_Record;
procedure Set_Modifiable_Info (The_Field : Field;
Modifiable_Info : Modifiable_Info_Record;
Success : out Status);
function Name (The_Field : Field) return String;
function Descriptor_Info (The_Field : Field)
return Descriptor_Info_Record;
function Default (The_Field : Field) return String;
function Default (The_Field : Field) return Integer;
function Default (The_Field : Field) return Boolean;
--
-- May raise Constraint_Error or Work_Order_Errors.Type_Mismatch
procedure Set_Default (The_Field : in out Field;
In_Venture : Venture_Handle;
Value : String;
Success : out Status;
Propagate : Boolean := False);
procedure Set_Default (The_Field : in out Field;
In_Venture : Venture_Handle;
Value : Boolean;
Success : out Status;
Propagate : Boolean := False);
procedure Set_Default (The_Field : in out Field;
In_Venture : Venture_Handle;
Value : Integer;
Success : out Status;
Propagate : Boolean := False);
--
-- Changing the default value for a field will only affect existing
-- work_orders if Propagate is True. New work orders will have their
-- fields initialized to the current default values.
procedure Count (For_Venture : Venture_Handle;
Fields : out Natural;
Success : out Status);
generic
with procedure Visit (Value : Field);
procedure Traverse (The_Venture : Venture_Handle; Success : out Status);
--
-- Do not Create or Delete fields while traversing.
end Venture_Field_Operations;
package Venture_Display is
procedure Display (Which : Venture_Id;
Options : String := "";
To_File : Io.File_Type := Io.Current_Output);
--
-- Write out a venture to a text file.
procedure Edit (Which : Venture_Id);
--
-- Cause the Venture_Object_Editor to display a unit.
end Venture_Display;
package Work_Order_Control is
procedure Find (Name : String;
Result : out Work_Order_Id;
Success : out Status);
--
-- Invoke name resolution on a string.
-- Returns bad status if the work_order cannot be found.
procedure Find (Work_Order_Number : Long_Integer;
Result : out Work_Order_Id;
Success : out Status);
--
-- A Work_Order_Number can be obtained from the function of
-- that name below. Numbers are unique.
procedure Create (Work_Order_Name : String;
The_Handle : out Work_Order_Handle;
Success : out Status;
On_Venture : Venture_Handle;
On_List : Work_Order_List_Handle :=
Null_Work_Order_List_Handle;
Notes : String := "";
Storage : System.Segment := System.Null_Segment;
For_User : User_Id := Default.Session);
--
-- New work_order will be open for Update.
-- On_Venture (and On_List if supplied) must be writable.
-- The Venture's action will be used, so close The_Handle
-- (and On_List) before closing On_Venture.
procedure Open (The_Work_Order : Work_Order_Id;
The_Handle : out Work_Order_Handle;
Success : out Status;
Mode : Open_Mode := Read;
Storage : System.Segment := System.Null_Segment;
Action_Id : Action.Id := Action.Null_Id);
--
-- The_Work_Order may not be opened with mode None.
procedure Close (The_Handle : in out Work_Order_Handle;
Success : out Status);
--
-- The_Handle will be set to Null_Work_Order_Handle after closing.
function Id (The_Handle : Work_Order_Handle) return Work_Order_Id;
function Mode (The_Handle : Work_Order_Handle) return Open_Mode;
function Full_Name (The_Handle : Work_Order_Handle) return String;
-- These information functions may be used on any handle.
end Work_Order_Control;
package Work_Order_Operations is
procedure Set_Default (To_Order : Work_Order_Handle;
For_Venture : Venture_Handle;
Success : out Status;
For_User : User_Id := Default.Session);
--
-- To_Order may be the Null_Work_Order_Handle.
-- For_Venture must be writable.
procedure Get_Default (On_Venture : Venture_Handle;
Result : out Work_Order_Id;
Success : out Status;
For_User : User_Id := Default.Session;
Ignore_Garbage : Boolean := True);
--
-- If Ignore_Garbage is True and the default work_order no
-- longer exists, Nil will be returned instead.
-- These two operations are really Venture operations.
type Status_Enumeration is (Pending, In_Progress, Closed);
subtype Configuration_Object is Directory.Object;
subtype Element_Name is String;
subtype Generation is Natural;
procedure Close (The_Order : Work_Order_Handle; Success : out Status);
--
-- Sets the Status_Enumeration to Closed.
-- The_Order must be writable.
procedure Add_User (To_Order : Work_Order_Handle;
Success : out Status;
The_User : User_Id := Default.Session);
procedure Add_Version (To_Order : Work_Order_Handle;
The_Configuration : Configuration_Object;
The_Element : Element_Name;
The_Generation : Generation;
Success : out Status;
When_Added : Calendar.Time := Calendar.Clock);
procedure Add_Configuration
(To_Order : Work_Order_Handle;
The_Configuration : Configuration_Object;
Success : out Status;
When_Added : Calendar.Time := Calendar.Clock);
procedure Add_Comment_Line
(To_Order : Work_Order_Handle;
The_Comment_Line : String;
The_Element_Name : Element_Name;
Success : out Status;
The_User : User_Id := Default.Session;
When_Added : Calendar.Time := Calendar.Clock);
-- The procedures above add new elements to the pre-defined fields.
-- To_Order must be writable.
function Work_Order_Number
(The_Order : Work_Order_Id) return Long_Integer;
--
-- 0 is a nil Work_Order_Number.
procedure Get_Parent (The_Order : Work_Order_Handle;
Result : out Venture_Id;
Success : out Status);
procedure Get_Status (The_Order : Work_Order_Handle;
Result : out Status_Enumeration;
Success : out Status);
type User_Info is
record
The_User : User_Id;
The_Time : Calendar.Time;
end record;
procedure Create_Info (The_Order : Work_Order_Handle;
The_Info : out User_Info;
Success : out Status);
procedure Close_Info (The_Order : Work_Order_Handle;
The_Info : out User_Info;
Success : out Status);
--
function Create_User_Name (The_Order : Work_Order_Handle) return String;
function Close_User_Name (The_Order : Work_Order_Handle) return String;
--------------------------------------------------------------
function Get_Notes (For_Order : Work_Order_Handle) return String;
--
-- Constraint_Error will be raised if the handle is not open.
procedure Set_Notes (To_Value : String;
For_Order : Work_Order_Handle;
Success : out Status);
--
-- For_Order must be writable before its notes may be changed.
-- Changing the notes will not mark an order as being In_Progress.
procedure Count_Versions (For_Work_Order : Work_Order_Handle;
Versions : out Natural;
Success : out Status);
generic
with procedure Visit (The_Configuration : Configuration_Object;
The_Element : Element_Name;
The_Generation : Generation;
The_Time : Calendar.Time);
procedure Traverse_Versions
(For_Work_Order : Work_Order_Handle; Success : out Status);
--
-- Do not Add_Versions while traversing.
-- Versions are time-ordered.
procedure Count_Configurations (For_Work_Order : Work_Order_Handle;
Configurations : out Natural;
Success : out Status);
generic
with procedure Visit (The_Configuration : Configuration_Object;
The_Time : Calendar.Time);
procedure Traverse_Configurations
(For_Work_Order : Work_Order_Handle; Success : out Status);
--
-- Do not Add_Configurations while traversing.
-- Configurations are time-ordered.
procedure Count_Users (For_Work_Order : Work_Order_Handle;
Users : out Natural;
Success : out Status);
generic
with procedure Visit (The_User : User_Id);
procedure Traverse_Users
(For_Work_Order : Work_Order_Handle; Success : out Status);
--
-- Do not Add_Users while traversing.
procedure Count_Comments (For_Work_Order : Work_Order_Handle;
Comments : out Natural;
Success : out Status);
generic
with procedure Visit (The_User : User_Id;
User_Name : String;
The_Comment : String;
The_Element : Element_Name;
The_Time : Calendar.Time);
procedure Traverse_Comments
(For_Work_Order : Work_Order_Handle; Success : out Status);
--
-- Do not Add_Comments while traversing.
-- Comments are time-ordered
-- The User_Name may be good even if the The_User no longer
-- exists. If the comment was generated in a Delta 2 system
-- then the user name is stored separately.
end Work_Order_Operations;
package Work_Order_Field_Operations is
subtype Field is Work_Order_Field;
function Null_Field return Work_Order_Field;
procedure Find (Field_Name : String;
The_Field : out Field;
Success : out Status;
In_Work_Order : Work_Order_Handle);
--
-- Search for the named field.
-- Returns Null_Field (and a warning) if Field_Name cannot be found.
-- Letter case and leading and trailing spaces are ignored.
function Name (The_Field : Field) return String;
function Descriptor_Info (The_Field : Field)
return Descriptor_Info_Record;
procedure High_Index (The_Field : Field;
Result : out Natural;
Success : out Status);
--
-- Return the highest index which has been used.
function Value (The_Field : Field) return String;
function Value (The_Field : Field) return Integer;
function Value (The_Field : Field) return Boolean;
function Value (The_Field : Field; Index : Natural) return String;
function Value (The_Field : Field; Index : Natural) return Integer;
function Value (The_Field : Field; Index : Natural) return Boolean;
-- Returns the current value.
-- If there is no current value, returns the default value.
-- Raises Type_Mismatch if the selector doesn't conform to the
-- type of the field.
-- Raises Mismatched_Vector_Operation if the selector doesn't
-- conform to the vector type.
-- Raises Constraint_Error on the Null_Field.
-- All uninitialized fields in a vector return the default.
-- An Index of 0 is interpreted as High_Index (1 if High_Index = 0).
function Is_Default (The_Field : Field) return Boolean;
function Is_Default
(The_Field : Field; Index : Positive) return Boolean;
--
-- Returns True if the field in question has never been
-- assigned a value using one of the procedures below.
procedure Set_Value (The_Field : in out Field;
The_Handle : Work_Order_Handle;
Value : String;
Success : out Status);
procedure Set_Value (The_Field : in out Field;
The_Handle : Work_Order_Handle;
Value : Boolean;
Success : out Status);
procedure Set_Value (The_Field : in out Field;
The_Handle : Work_Order_Handle;
Value : Integer;
Success : out Status);
procedure Set_Value (The_Field : in out Field;
The_Handle : Work_Order_Handle;
Index : Natural;
Value : String;
Success : out Status);
procedure Set_Value (The_Field : in out Field;
The_Handle : Work_Order_Handle;
Index : Natural;
Value : Boolean;
Success : out Status);
procedure Set_Value (The_Field : in out Field;
The_Handle : Work_Order_Handle;
Index : Natural;
Value : Integer;
Success : out Status);
--
-- Sets the value of the field.
-- The field must not already have a (non-default) value.
-- An index of 0 is interpreted as High_Index + 1.
-- The_Handle must be writable.
procedure Count (For_Work_Order : Work_Order_Handle;
Fields : out Natural;
Success : out Status);
generic
with procedure Visit (Value : Field);
procedure Traverse (The_Work_Order : Work_Order_Handle;
Success : out Status);
--
-- Do not Create or Delete fields while traversing.
end Work_Order_Field_Operations;
package Work_Order_Display is
procedure Display (Which : Work_Order_Id;
Options : String := "";
To_File : Io.File_Type := Io.Current_Output);
--
-- Write out a work_order to a text file.
procedure Edit (Which : Work_Order_Id);
--
-- Cause the Work_Order_Object_Editor to display an object.
end Work_Order_Display;
package Work_Order_List_Control is
procedure Find (List_Name : String;
Result : out Work_Order_List_Id;
Success : out Status);
--
-- Invoke name resolution on a string.
-- Returns bad status if the list cannot be found.
procedure Create (List_Name : String := ">>OBJECT NAME<<";
The_Handle : out Work_Order_List_Handle;
Success : out Status;
On_Venture : Venture_Handle;
Notes : String := "";
Storage : System.Segment := System.Null_Segment);
--
-- New work_order_list will be open for Update.
-- On_Venture must be writable.
-- The Venture's action will be used, so close The_Handle
-- before closing On_Venture.
procedure Open (The_List : Work_Order_List_Id;
The_Handle : out Work_Order_List_Handle;
Success : out Status;
Mode : Open_Mode := Read;
Storage : System.Segment := System.Null_Segment;
Action_Id : Action.Id := Action.Null_Id);
--
-- The_List may not be opened with mode None.
procedure Close (The_Handle : in out Work_Order_List_Handle;
Success : out Status);
--
-- The_Handle is set to Null_Work_Order_List_Handle after closing.
function Id (The_Handle : Work_Order_List_Handle)
return Work_Order_List_Id;
function Mode (The_Handle : Work_Order_List_Handle) return Open_Mode;
function Full_Name (The_Handle : Work_Order_List_Handle) return String;
-- These information functions may be used on any handle.
end Work_Order_List_Control;
package Work_Order_List_Operations is
procedure Set_Default (To_List : Work_Order_List_Handle;
For_Venture : Venture_Handle;
Success : out Status;
For_User : User_Id := Default.Session);
--
-- To_List may be the Null_Work_Order_List_Handle.
-- For_Venture must be writable.
procedure Get_Default (On_Venture : Venture_Handle;
Result : out Work_Order_List_Id;
Success : out Status;
For_User : User_Id := Default.Session;
Ignore_Garbage : Boolean := True);
--
-- If Ignore_Garbage is True and the default list no longer
-- exists, Nil will be returned instead.
-- These two operations are really Venture operations.
procedure Add (The_Work_Order : Work_Order_Handle;
To_List : Work_Order_List_Handle;
Success : out Status);
--
-- Adds a work order to a list.
-- The_Work_Order must have the same parent venture as To_List.
-- To_List must be writable.
procedure Remove (The_Work_Order : Work_Order_Id;
From_List : Work_Order_List_Handle;
Success : out Status);
--
-- Remove a work_order from a list.
-- The work order itself is unaffected.
-- From_List must be writable.
procedure Get_Parent (The_List : Work_Order_List_Handle;
Result : out Venture_Id;
Success : out Status);
function Get_Notes (For_List : Work_Order_List_Handle) return String;
--
-- Constraint_Error will be raised if the handle is not open.
procedure Set_Notes (To_Value : String;
For_List : Work_Order_List_Handle;
Success : out Status);
--
-- For_List must be writable before its notes may be changed.
procedure Count (For_List : Work_Order_List_Handle;
Work_Orders : out Natural;
Success : out Status);
generic
with procedure Visit (The_Work_Order : Work_Order_Id);
procedure Traverse (For_List : Work_Order_List_Handle;
Success : out Status);
--
-- Do not Add or Remove work orders while traversing.
end Work_Order_List_Operations;
package Work_Order_List_Display is
procedure Display (Which : Work_Order_List_Id;
Options : String := "";
To_File : Io.File_Type := Io.Current_Output);
--
-- Write out a Work_Order_List to a text file.
procedure Edit (Which : Work_Order_List_Id);
--
-- Cause the Work_Order_List_Object_Editor to display an object.
end Work_Order_List_Display;
end Work_Order_Implementation;