|
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 - download
Length: 34816 (0x8800) Types: Ada Source Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package Gateway_Object, pragma Module_Name 4 3995, pragma Segmented_Heap Handle, pragma Subsystem Tools_Integration, seg_00f2a0
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000 └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« └─⟦this⟧
with Action; with Directory; with Io; with Job_Segment; with Polymorphic_Io; with Simple_Status; with System; package Gateway_Object is package Dir renames Directory; -- Interface for manipulating Dtia Gateway objects -- -- A Dtia Gateway object is a file which contains a number of property -- values. There may, in addition, be zero or more sub-objects -- under the file. -- -- A Gateway_Object.Handle can represent a number of open Dtia objects -- all related in some way. There is one main object referenced -- by a Handle. It is the only one that can be updated. Other -- objects can be opened using the same handle, but these are always -- opened for read. -- -- This package contains three groups of operations. The first is -- for creating Gateway classes. A gateway class defines the -- properties that objects of the class will specify. It also can -- define types which specify the set of values for properties of the type. -- The second group of operations handles the creation of Gateway objects. -- The final group is used to read and set the values of Gateway -- and Gateway class properties. -------------------------------------------------- -- -- Operations for creating Gateway classes -- -- type Handle is private; -- Handles are dynamically allocated on a supplied heap. A handle can -- be reused after it is closed. Thus, if you carefully declare -- handles, few will be allocated. -- Null_Handle : constant Handle; -- type Slot_Id is new Integer; -- unique id for object's slot in handle Nil_Slot_Id : constant Slot_Id := 0; Main_Slot : constant Slot_Id := 1; Class_Slot : constant Slot_Id := 2; -- -- A Handle designates an open Gateway class or object. The Handle -- designates one main object (which can be updated). Additional -- objects can be opened for read under a single handle. Each is -- opened under the same action and each has an Id associated with -- it. This Id is supplied by the opener and is also supplied with -- each use of a Handle. The Id identifies which object opened in -- the handle will actually be accessed by a given call. -- A Gateway class is a pattern from which other gateway objects are -- constructed. The class may also contain default values that -- are inherited by the objects. In addition, the class can define -- enumeration types that are used in objects of the class. -- The class defines the properties that objects of the class can -- specify. -- -- Each property has a type. The type must be either a predefined type -- or a type defined in the class. Each type has an Id, and this Id -- is used to reference the type in some contexts. The type Id must -- be unique within the class, but different classes may reuse type -- ids. subtype Type_Id is Natural range 0 .. 2 ** 16 - 1; -- Identifies a type Null_Type_Id : constant Type_Id := 0; -- This value is reserved. -- Type_Id values are partitioned into predefined types and class-defined -- types. Predefined values are allocated at the high end of the -- range. First_Predefined_Type : constant Type_Id := 65000; Natural_Type_Id : constant Type_Id := 65000; Long_Integer_Type_Id : constant Type_Id := 65001; Boolean_Type_Id : constant Type_Id := 65002; String_Type_Id : constant Type_Id := 65003; Date_Type_Id : constant Type_Id := 65004; Script_Type_Id : constant Type_Id := 65005; -- Class defined Type_Ids are stored using a contiguous vector -- indexed by the Type_Id. There can be unused values, but -- all array elements in the range are allocated, so don't -- choose the Type Ids to be sparse. -- prefined property-type names: -------------------------------- Natural_Property_Type_Name : constant String := "Natural"; Long_Integer_Property_Type_Name : constant String := "Long_Integer"; Boolean_Property_Type_Name : constant String := "Boolean"; String_Property_Type_Name : constant String := "String"; Date_Property_Type_Name : constant String := "Date"; Script_Property_Type_Name : constant String := "Script"; procedure Create_Class (Class_Name : String; Highest_Class_Type_Id : Type_Id; H : in out Handle; Action_Id : Action.Id := Action.Null_Id; Heap : System.Segment := Job_Segment.Get; Errors : in out Simple_Status.Condition); -- -- Create a definition for Class_Name which will contain type definitions -- and property names and default values. These are defined by -- calls to the Add_Type and Add_Property procedures below. Close -- must be called once all the properties and types are defined. -- -- If the Highest_Class_Type_Id must be changed, the class must be -- deleted and rebuilt. As long as the Type_Id values defined for each -- type are the same, this is not a problem for objects that reference -- the class. -- -- If H is null, it is allocated on the specified Heap. The Main_Slot -- and Class_Slot entries in the Handle both refer to the opened -- new class object. procedure Add_Type (Class_Handle : in out Handle; Id : Type_Id; Type_Name : String; Enumeration_Literals : String; Errors : in out Simple_Status.Condition); -- -- Add a type to the open class Class_Handle which was created with -- Create_Class. Type_Id must be <= Highest_Class_Type_Id -- and not already defined. The Enumeration_Literals list -- is a comma-separated list of legal Ada identifiers (which can -- be empty). procedure Add_Property (Class_Handle : in out Handle; Property_Name : String; Property_Type : String; Property_Value : String; Is_Constant : Boolean; Editable : Boolean; Non_Display : Boolean; Never_Display : Boolean; No_Inherit : Boolean; No_Eval : Boolean; Edit_Acl_From : String; Help_Text : String; Errors : in out Simple_Status.Condition); -- -- Add a property to the already-open class designated by Class_Handle. -- The name, type, etc. of the property are specified by the parameters. -- Property_Type Must be a predefined type or a type whose name -- is already defined in the class. -- Property_Value will be the default value for the property -- in gateway objects of this class. -- Is_Constant implies that the value is not changeable in the -- gateway object once inherited. -- Editable implies that the value is editable using the -- Gateway OE. Does not affect programmatic -- update of the object. -- Non_Display implies that the Gateway OE will not display -- this property by default. -- Never_Display implies that the Gateway OE will never -- display the property. -- No_Inherit implies that, when an object is created, this -- property will not be inherited from the class. -- No_Eval implies that this property's value will not be -- evaluated as a possible indirection specification, -- but will be used as is. -- Edit_Acl_From names a file whose acl is used to control update -- of the property from the editor or as is desired. -- W access to the file is required to -- update the property value. -- If null, no acl check is performed (other than -- normal update (W) access to the object itself). -- If a file is named but does not exist or cannot -- be located, this is equivalent to not having W -- access which prevents the property update. -- Help_Text A structured string that is displayed when help -- is requested for the property in the Gateway OE. -- *** work to be done here: specify structure -- -- Error if Class_Handle does not designate a class, or any of the -- property values are illegal in some way. --------------------------------------------------- -- -- Operations for creating Gateway objects -- -- --------------------------------------------------- procedure Create (Name : String; H : in out Handle; Dir_Class : String := "File"; Dir_Subclass : String := ""; Gateway_Class : String; Action_Id : Action.Id := Action.Null_Id; Heap : System.Segment := Job_Segment.Get; Errors : in out Simple_Status.Condition); -- Create a Gateway object. Dir_Class and Dir_Subclass indicates the -- kind of object. Currently, Dir_Class must be "File" and Dir_Subclass -- can be any legal Gateway file subclass. If the Gateway_Class has a -- property "Directory_Subclass", then the parameter Dir_Subclass may -- be null and the subclass will be taken from the Gateway class -- property. -- -- The Gateway_Class may specify that subobjects be created. If so, they -- will be created as part of this operation. -- -- Property definitions will be inherited from the Gateway_Class. -- If the class includes default values for properties, these will -- also be inherited. -- -- The new Gateway object is left open with H as its handle. It must -- be closed at some point to complete the creation (see Close below). -- -- Once created, the object is open and additional property values -- can be assigned or interrogated. -- -- The Main_Slot entry in the handle is set for the new object. The -- Class_Slot entry is set for the object's gateway class. ---------------------------------------------------------------- -- -- Operations for accessing Gateway Objects and values -- ---------------------------------------------------------------- function Is_Gateway_Object (The_Object : Dir.Object) return Boolean; -- true if gateway_object procedure Open_Main_Object (Object : String; H : in out Handle; Update : Boolean := False; Action_Id : Action.Id := Action.Null_Id; Heap : System.Segment := Job_Segment.Get; Errors : in out Simple_Status.Condition); -- -- Open the named object which must be a Gateway object or class -- as the handle's main object. Also opens the Gateway object's class -- in the handle's class slot. -- -- Update indicates that the object is opened for update. -- Update access to property values is further -- controlled by the Edit_Acl_From mechanism. -- -- If H is null, it is allocated on the specified Heap. -- The object is opened using the Main_Slot entry in the handle. procedure Open_Main_Object (Object : Dir.Object; H : in out Handle; Update : Boolean := False; Action_Id : Action.Id := Action.Null_Id; Heap : System.Segment := Job_Segment.Get; Errors : in out Simple_Status.Condition); -- Same as above Open_Main_Object, except takes a Dir.Object -- instead of a name procedure Open_Unactivated_Class (Class_Object_Name : String; H : in out Handle; Update : Boolean := False; Action_Id : Action.Id := Action.Null_Id; Heap : System.Segment := Job_Segment.Get; Errors : in out Simple_Status.Condition); -- -- Open the named object which must be a class object that is not -- currently activated as the handle's main object. -- -- Update indicates that the object is opened for update. -- Update access to property values is further -- controlled by the Edit_Acl_From mechanism. -- -- If H is null, it is allocated on the specified Heap. -- The object is opened using the Main_Slot entry in the handle. procedure Re_Open_Main_Object_For_Update (H : in out Handle; Errors : in out Simple_Status.Condition); -- If the handle's main slot's object was open but not for update, close -- it and re-open it for update. No-op if it was already opened for update. -- An error will result if no object is open, or the object could not -- be re-opened. procedure Open (Object : String; Slot : Slot_Id; H : in out Handle; Action_Id : Action.Id := Action.Null_Id; Heap : System.Segment := Job_Segment.Get; Errors : in out Simple_Status.Condition); -- -- Open the named object which must be a Gateway object or class. -- The object may then be referenced by H and Slot. -- -- The handle H may already designate one or more open objects. -- The new one is placed in the specified slot which must not already -- be in use. -- -- If H is null, it is allocated on the specified Heap. procedure Open_Object (Object : String; Slot : Slot_Id; H : Handle; Action_Id : Action.Id := Action.Null_Id; Errors : in out Simple_Status.Condition); -- Exactly identical to Open, but with H as an "in" parameter and -- already allocated. Modifies H's data because Handle is an access type. -------------------------------------------------------------- -- -- Operations to read and update Gateway property values. -- -------------------------------------------------------------- function Value (H : Handle; Property_Name : String; Slot : Slot_Id := Main_Slot; Subobject : String := "") return String; -- -- Return the value of the named property (Name) from the designated -- gateway object (H). If Subobject /= "", then the property of the -- thus-named subobject is returned. The value returned is the "raw" -- value stored in the object; it is not processed (to resolve -- indirection or other value conventions). To read processed -- values, use package Gateway_Property. -- H may have more than one open object in it. The value is read from the -- one designated by Slot. -- Exceptions raised: -- Undefined_Property_Name if the property is undefined; -- No_Open_Object if the handle's Slot specifies no open object. No_Open_Object : exception; Undefined_Property_Name : exception; procedure Set_Value (H : Handle; Property_Name : String; Subobject : String := ""; New_Value : String); -- Set the value of property Name in gateway object H to New_Value. -- If Subobject /= "", then set the value of property Name for the -- specified subobject. The New_Value is placed into the object -- as is for a string value or New_Value is illegal for the property's type, -- or with some processing depending on the object's type. -- H may have more than one open object in it. Only the main object -- can be updated. It must have been opened for update for this operation -- to be successful. -- Does NOT do access checking; this must be done by the caller. -- Exceptions raised: -- No_Open_Object if the handle specifies no open object; -- Not_Open_For_Update if the object was opened with update := false; -- Property_Cant_Be_Changed if the property was defined to be constant. -- Undefined_Property_Name if the property is undefined; Not_Open_For_Update : exception; Property_Cant_Be_Changed : exception; Illegal_Property_Value : exception; function Class_Name (H : Handle; Slot : Slot_Id := Main_Slot) return String; -- Returns the gateway class name of the object opened in the handle's -- specified slot; raises No_Open_Object if none function Action_Id (H : Handle) return Action.Id; -- Returns the action_id current in use by H function Object_Name (H : Handle; Slot : Slot_Id := Main_Slot) return String; -- Returns name of the object opened in the handle's specified slot; -- "" if none function Directory_Object (H : Handle; Slot : Slot_Id := Main_Slot) return Dir.Object; -- Returns the object opened in the handle's specified slot; -- Dir.Nil if none function Slot_For_Object (H : Handle; Object : Dir.Object) return Slot_Id; -- If Object is open in one or more of handle's slots, return the id of -- the first slot containing object; else, return Null_Slot function Is_Object_Open (H : Handle; Slot : Slot_Id := Main_Slot) return Boolean; -- Returns true iff an object is open in the handle's specified slot function Is_Main_Object_Open_For_Update (H : Handle) return Boolean; -- Returns true iff the handle's main slot's object is open for update function Is_Class_Object (H : Handle; Slot : Slot_Id := Main_Slot) return Boolean; -- Returns true iff the object in the specified slot is a class object procedure Get_Class_Id (H : Handle; Index : out Natural; Serial_Number : out Natural); -- Return the class id numbers of the class of the main object in -- handle H. This is mainly of use by internal packages. generic with procedure Visit (Property_Name : String; Subobject : String; Property_Type : Type_Id; Value : String); -- Each call to Visit specifies the property's name, subobject, -- value, and type. procedure Traverse (H : Handle; Slot : Slot_Id := Main_Slot); -- Call Visit for each of the property values defined in H's specified slot. -- iterators for reading all enumeration types for a class: type Enumeration_Type_Iterator is limited private; procedure Init (Iter : out Enumeration_Type_Iterator; H : Handle); -- Starts iterating over enumeration types for class of main object opened -- in handle. Done (Iter) will be true if error occurred. procedure Next (Iter : in out Enumeration_Type_Iterator); function Value (Iter : Enumeration_Type_Iterator) return Type_Id; function Done (Iter : Enumeration_Type_Iterator) return Boolean; -- iterators for reading all enumeration literals for a enumeration type: type Enumeration_Literal_Iterator is limited private; procedure Init (Iter : out Enumeration_Literal_Iterator; H : Handle; Id : Type_Id); -- Starts iterating over enumeration literals for enumeration type id of -- main object opened in handle. Done (Iter) will be true if error occurred. procedure Next (Iter : in out Enumeration_Literal_Iterator); function Value (Iter : Enumeration_Literal_Iterator) return String; -- enumeration literal, capitalized with no punctuation function Done (Iter : Enumeration_Literal_Iterator) return Boolean; function Type_Info (H : Handle; Property_Name : String; Slot : Slot_Id := Main_Slot; Subobject : String := "") return Type_Id; -- Return the type of the specified property in the specified object -- in the handle. function Property_Options_Image (H : Handle; Property_Name : String; Slot : Slot_Id := Main_Slot) return String; -- return an image of the property options for the specified -- property in the specified object in the handle. -- queries for individual options: function Is_Constant (H : Handle; Property_Name : String; Slot : Slot_Id := Main_Slot) return Boolean; -- Return the IS_CONSTANT option for the specified property in the handle's -- specified object. function Editable (H : Handle; Property_Name : String; Slot : Slot_Id := Main_Slot) return Boolean; -- Return the EDITABLE option for the specified property in the handle's -- specified object. function Non_Display (H : Handle; Property_Name : String; Slot : Slot_Id := Main_Slot) return Boolean; -- Return the NON_DISPLAY option for the specified property in the handle's -- specified object. function Never_Display (H : Handle; Property_Name : String; Slot : Slot_Id := Main_Slot) return Boolean; -- Return the NEVER_DISPLAY option for the specified property in the handle's -- specified object. function No_Inherit (H : Handle; Property_Name : String; Slot : Slot_Id := Main_Slot) return Boolean; -- Return the NO_INHERIT option for the specified property in the handle's -- specified object. function No_Eval (H : Handle; Property_Name : String; Slot : Slot_Id := Main_Slot) return Boolean; -- Return the NO_EVAL option for the specified property in the handle's -- specified object. function Edit_Acl_From (H : Handle; Property_Name : String; Slot : Slot_Id := Main_Slot) return String; -- Return the EDIT_ACL_FROM option for the specified property in the -- handle's specified object. function Help_Text (H : Handle; Property_Name : String; Slot : Slot_Id := Main_Slot) return String; -- Return the HELP_TEXT option for the specified property in the -- handle's specified object. function Type_Def (H : Handle; Id : Type_Id) return String; -- Return an image of the type information for the specified type, as -- defined for the gateway class of H's main slot's object. -- Raise Undefined_Type_Id if Id is out-of-range or not defined in the -- class. function Type_Name (H : Handle; Id : Type_Id) return String; -- Return the name for the specified type, as defined for the gateway -- class of H's main slot's object. -- Raise Undefined_Type_Id if Id is out-of-range or not defined in the -- class. Undefined_Type_Id : exception; function Property_Value_Image (H : Handle; Property_Name : String; Id : Type_Id; Image : String) return String; -- Returns Image formatted for its type. -- Raises Undefined_Type_Id if Id not defined in the class designated by H. -- Raises Illegal_Property_Value if invalid image for type. -- uses property_name in semantic checking of indirections -- Returns Image formatted for its type. -- Raises Undefined_Type_Id if Id not defined in the class designated by H. -- Raises Illegal_Property_Value if invalid image for type. procedure Close (H : Handle); -- Changes do not become permanent until the object is closed or committed. -- If you know that only objects placed into the handle via the -- Make_... procedures contain changes, then you can commit those -- objects and not bother with this call, but this is not advised. procedure Close (H : Handle; Errors : in out Simple_Status.Condition); -- same as above close, but returns status procedure Commit (H : Handle; Re_Open_For_Update : Boolean; Errors : in out Simple_Status.Condition); -- Commits and closes all opened objects in the handle and re-opens them. -- If Re_Open_For_Update, opens the main object for update. procedure Release_Slot (H : Handle; Slot : Slot_Id; Errors : in out Simple_Status.Condition); -- Closes the object in just the specified slot and release it. -- Implementation actually closes all the handle's objects and re-opens -- all but the one in slot. -- If Object is open in one of handle's slots, return the slot's id; -- else, return Null_Slot pragma Subsystem (Tools_Integration); pragma Module_Name (4, 3995); pragma Bias_Key (29); private type Handle_Data; type Handle is access Handle_Data; pragma Segmented_Heap (Handle); -- type Handle_Data is roughly: -- handles : array (1..max) of polymorphic_io.handle; -- opens : 0..max Null_Handle : constant Handle := null; -- type Enumeration_Type_Iterator_Value; type Enumeration_Type_Iterator is access Enumeration_Type_Iterator_Value; type Enumeration_Literal_Iterator_Value; type Enumeration_Literal_Iterator is access Enumeration_Literal_Iterator_Value; end Gateway_Object;
nblk1=21 nid=0 hdr6=42 [0x00] rec0=1e rec1=00 rec2=01 rec3=030 [0x01] rec0=1a rec1=00 rec2=02 rec3=066 [0x02] rec0=00 rec1=00 rec2=21 rec3=006 [0x03] rec0=13 rec1=00 rec2=03 rec3=02e [0x04] rec0=15 rec1=00 rec2=04 rec3=02c [0x05] rec0=03 rec1=00 rec2=20 rec3=012 [0x06] rec0=13 rec1=00 rec2=05 rec3=068 [0x07] rec0=01 rec1=00 rec2=1f rec3=018 [0x08] rec0=13 rec1=00 rec2=06 rec3=028 [0x09] rec0=11 rec1=00 rec2=07 rec3=07e [0x0a] rec0=10 rec1=00 rec2=08 rec3=026 [0x0b] rec0=0e rec1=00 rec2=09 rec3=036 [0x0c] rec0=17 rec1=00 rec2=0a rec3=00e [0x0d] rec0=12 rec1=00 rec2=0b rec3=078 [0x0e] rec0=17 rec1=00 rec2=0c rec3=05e [0x0f] rec0=14 rec1=00 rec2=0d rec3=000 [0x10] rec0=13 rec1=00 rec2=0e rec3=060 [0x11] rec0=16 rec1=00 rec2=0f rec3=00c [0x12] rec0=17 rec1=00 rec2=10 rec3=068 [0x13] rec0=18 rec1=00 rec2=11 rec3=04a [0x14] rec0=00 rec1=00 rec2=1e rec3=012 [0x15] rec0=15 rec1=00 rec2=12 rec3=014 [0x16] rec0=19 rec1=00 rec2=13 rec3=088 [0x17] rec0=00 rec1=00 rec2=1d rec3=00e [0x18] rec0=1a rec1=00 rec2=14 rec3=042 [0x19] rec0=17 rec1=00 rec2=15 rec3=038 [0x1a] rec0=17 rec1=00 rec2=16 rec3=052 [0x1b] rec0=17 rec1=00 rec2=17 rec3=060 [0x1c] rec0=14 rec1=00 rec2=18 rec3=084 [0x1d] rec0=16 rec1=00 rec2=19 rec3=014 [0x1e] rec0=19 rec1=00 rec2=1a rec3=008 [0x1f] rec0=11 rec1=00 rec2=1b rec3=07e [0x20] rec0=1e rec1=00 rec2=1c rec3=000 tail 0x2170bb36e822a62acfe68 0x42a00088462065003