DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦a5fab3aaf⟧ Ada Source

    Length: 18432 (0x4800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package Gateway_Property, pragma Module_Name 4 4120, pragma Subsystem Tools_Integration, seg_00f2a1

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

E3 Source Code



with Gateway_Object;
with Device_Independent_Io;
package Gateway_Property is

    subtype Handle is Gateway_Object.Handle;

    Undefined_Property_Name :
       exception renames Gateway_Object.Undefined_Property_Name;
    No_Open_Object : exception renames Gateway_Object.No_Open_Object;
    Not_Open_For_Update : exception renames Gateway_Object.Not_Open_For_Update;
    Illegal_Property_Value : exception
                                 renames Gateway_Object.Illegal_Property_Value;
    Evaluation_Failed : exception;

    function Value (H             : Handle;
                    Property_Name : String;
                    Subobject     : String := "") return String;

    function Value_With_Default (H             : Handle;
                                 Property_Name : String;
                                 Default       : String := "";
                                 Subobject     : String := "") return String;
    --
    -- Return the value of the named property (Property_Name) from the
    -- designated gateway object (H/Main_Slot_Id). If Subobject /= "", then
    -- the value of the property of the thus-named subobject is returned.
    -- The value returned is the evaluated value of the property based on the
    -- textual property value in the object.
    --
    -- If there is no such property, the exception Undefined_Property_Name
    -- is raised (Value).  Value_With_Default returns the Default value
    -- in that case rather than raising an exception.
    --
    -- If the value of the property cannot be evaluated without error then the
    -- exception Evaluation_Failed is raised. In that case, the Value_Diagnosis
    -- function can be called to get error information.


    -- Evaluation returns a string identical to the textual value of the
    -- property except for cases where the textual value of the property
    -- contains embedded strings representing valid indirections. These
    -- will be replaced by the corresponding textual value in the same
    -- position:
    --
    --  <Class>                 -- Retrieve the value from the same-named
    --                             property in the class.  The class is
    --                             determined from the Class_Name property.
    --  <Class,Property_Name>   -- Retrieve property 'Property_Name' from the
    --                             class.
    --  <Parent>                -- Retrieve the value from the same-named
    --                             property in the object referred to by the
    --                             value of the "Parent_Name" property, which
    --                             is a filename.
    --  <Parent,Property_Name>  -- Retrieve property 'Property_Name' from the
    --                             parent.
    --  <Switch>                -- Obtain the value from the class and library
    --                             switch file. The value of the class property
    --                             "Switch_For_<Property_Name>" names the
    --                             switch to be interrogated.
    --  <Session>               -- Obtain the value from the class and session
    --                             switch file. The value of the class property
    --                             "Switch_For_<Property_Name>" names the
    --                             switch to be interrogated.
    -- Some rules:
    --  1.  Class_Name must always be a simple value and is never
    --      evaluated or indirected, etc.
    --  2.  Parent_Name must always be a simple value and is never
    --      evaluated or indirected, etc.
    --  3.  There is a maximum of 10 levels of indirection.
    --  4.  For "String" properties the textual value of the property may
    --      contain one or more indirections as well as other text. For other
    --      types of property the textual value must either be a legal value
    --      for that type or a valid indirection string.

    --
    -- These rules prevent infinite indirections when evaluating
    -- property values.

    function Check_Indirection (H             : Gateway_Object.Handle;
                                Property_Name : String;
                                Value         : String) return Boolean;
    --
    -- checks whether a given property_name/indirection combination "may" be
    -- valid for a handle. Full static checking can only be done for <Class>
    -- indirections, in all other cases only syntax checking can be performed.

    function Check_Indirection (Value : String) return Boolean;
    --
    -- perform syntax checking on the indirection string supplied

    function Value_Diagnosis
                (H : Handle; Property_Name : String; Subobject : String := "")
                return String;
    --
    -- Return error information about why the named property could not
    -- be read.  Use when Value raises an exception.



    -- Generic to read a value and return it as a specific type:

    generic
        type T is private;                          -- Target type
        Error_Value : T;                            -- Value to return if error
        with function Value (S : String) return T;  -- Conversion function
        Missing_Is_Error : Boolean := False;        -- else return Default
        type Error_Destination is private;          -- info on where errors go
        Error_Default : Error_Destination;          -- Default for errors
        with procedure Put_Error (S : String; Destination : Error_Destination);
        No_Exceptions : Boolean := True;            -- else let exception fly

    function Property_Value_Generic
                (Handle        : Gateway_Object.Handle;
                 Property_Name : String;
                 Subobject     : String            := "";
                 Default       : T                 := Error_Value;
                 Destination   : Error_Destination := Error_Default) return T;
    --
    -- Convert the value of the named property to T and return it.  If
    -- there is no such property, return Default.  If an error occurs,
    -- Destination says what to do with it.
    --
    -- Missing_Is_Error generic formal makes "no such property" an error.
    --
    -- Instantiations can use the following types and procedures for Error_
    -- Destination, Error_Default, and Put_Error.


    type No_Error_Info is
        record
            null;
        end record;

    procedure Log_Put_Line (Message : String; Info : No_Error_Info);
    -- write to log file with profile.Get.

    procedure Message_Window_Put (Message : String; Info : No_Error_Info);
    -- Write message to message window on screen.



    procedure Set_Value (H             :     Handle;
                         Property_Name :     String;
                         New_Value     :     String;
                         Success       : out Boolean;
                         Subobject     :     String := "");
    --
    -- Set the value of the property with Name in gateway object H/Main_Slot_Id
    -- to New_Value.  If subobject /= "", then set the value of property
    -- Name in the subobject.  The New_Value is placed into the object
    -- as is.  Success=true => the operation was successful.  The change
    -- is not committed until the handle is closed, of course.

    function Set_Value_Diagnosis (H             : Handle;
                                  Property_Name : String;
                                  New_Value     : String;
                                  Subobject     : String := "") return String;
    --
    -- return an error message explaining why the Set_Value with the
    -- specified parameters failed.  Should be called after Set_Value returns
    -- Success = false.

    package Predefined is

        -- Predefined Property names

        Class_Name : constant String := "Class_Name";
        Parent_Name : constant String := "Parent_Name";
        Connected   : constant String := "Connected";

        -- Properties controlling actions when gateway classes are activated
        Activation_Server_Name : constant String := "Activation.Server_Name";

        -- Properties controlling actions when objects are created.
        Directory_Subclass : constant String := "Create.Directory_Subclass";
        Initial_Subobjects : constant String := "Create.Initial_Subobjects";

        -- Properties controlling default editor behavior
        Edit_Banner          : constant String := "Edit.Banner";
        Edit_Header          : constant String := "Edit.Header";
        Edit_Object          : constant String := "Edit.Object";
        Edit_Ws_Message_Text : constant String := "Edit.Ws_Message_Text";
        Edit_Message_Text    : constant String := "Edit.Message_Text";
        Edit_Display_Action  : constant String := "Edit.Display_Action";


        -- Values for Edit_Display_Action:
        Ws_Only         : constant String := "Ws_Only";
        Ws_Else_Local   : constant String := "Ws_Else_Local";
        Ws_Else_Message : constant String := "Ws_Else_Message";
        Local           : constant String := "Local";  
        Message_Only    : constant String := "Message_Only";
        No_Action       : constant String := "No_Action";

        -- Special values for Edit.Object
        Edit_Object_Null : constant String := "Null";



        -- Properties controlling I/O operations
        Form_Map : constant String := "Io.Form_Map";

        -- Properties controlling Dispatch operations
        Dispatch_Map : constant String := "Dispatch.Map";
    end Predefined;

    -- Abstractions for values of certain properties:

    -- Io.Form_Map
    --

    function Subobject_Name
                (Form_Map        : String;
                 Form            : String;
                 Mode            : Device_Independent_Io.File_Mode;
                 Divert_Prefix   : String := "";
                 Raise_Prefix    : String := "<Exception>";
                 Filter_Prefix   : String := "<Filter>";
                 External_Prefix : String := "<External>") return String;
    --
    -- Form_Map is the value of the Io.Form_Map property of some Gateway
    -- object.  Form is a form parameter that could be used to open
    -- the gateway object.   Mode is In_File or Out_File.
    --
    -- Return information about what would happen if the object were
    -- opened with the indicated form and mode parameters.  The format of the
    -- return string is either null if there is an error or the Form_Map
    -- does not define what should happen, or one of four prefixes
    -- followed by additional information.  The prefix indicates the action
    -- of the form map.
    --
    -- If the prefix for an action is "<>", then the null string is returned
    -- for that action.
    --
    -- For a diversion to a subobject, the additional information is the
    -- Gateway-relative pathname of the subobject.
    -- For a Raise operation, there is no additional information
    -- For a Filter operation, the additional information is the program
    -- name to be run.
    -- For an External operation, there is no additional information.
    --

    function Fully_Qualified_Subobject_Name
                (Object : Handle; Subobject_Relative_Name : String)
                return String;
    -- Return the fully qualified name of the subobject whose
    -- relative name is subobject_relative_name (from Subobject_Name).


    function Form_Append
                (Form_Map : String; Form_Map_Entry : String) return String;
    --
    -- Return the string representing the form map when Form_Map_Entry
    -- is added to Form_Map.  Raises Constraint_Error if either parameter
    -- is illegal in some way.

    function Eval (Value : String; Object : String; Property_Name : String)
                  return String;
    -- evaluate Value as if it were the value of the given Property in a
    -- the given gateway object, raise Evaluation_Failed if Value cannot
    -- be evaluated in that context

    function Eval_Diagnosis
                (Value : String; Object : String; Property_Name : String)
                return String;
    -- returns an error message indicating why value cannot be evaluated
    -- in the given context

    function Eval_Quote (Value : String) return String;
    -- return a string in which "special" characters in value have been
    -- quoted so they will not cause special actions during evaluation or
    -- cause Evaluation_Failed to be raised

    function Eval_Unquote (Value : String) return String;
    -- return a string in which quoted "special" characters in value have
    -- been unquoted so they will cause special actions during evaluation


    pragma Module_Name (4, 4120);
    pragma Bias_Key (29);
    pragma Subsystem (Tools_Integration);
end Gateway_Property;

E3 Meta Data

    nblk1=11
    nid=0
    hdr6=22
        [0x00] rec0=19 rec1=00 rec2=01 rec3=038
        [0x01] rec0=12 rec1=00 rec2=02 rec3=01e
        [0x02] rec0=10 rec1=00 rec2=03 rec3=008
        [0x03] rec0=0f rec1=00 rec2=04 rec3=046
        [0x04] rec0=18 rec1=00 rec2=05 rec3=000
        [0x05] rec0=14 rec1=00 rec2=06 rec3=040
        [0x06] rec0=1c rec1=00 rec2=07 rec3=032
        [0x07] rec0=16 rec1=00 rec2=08 rec3=026
        [0x08] rec0=00 rec1=00 rec2=11 rec3=002
        [0x09] rec0=11 rec1=00 rec2=09 rec3=078
        [0x0a] rec0=03 rec1=00 rec2=10 rec3=018
        [0x0b] rec0=1c rec1=00 rec2=0a rec3=052
        [0x0c] rec0=00 rec1=00 rec2=0f rec3=034
        [0x0d] rec0=14 rec1=00 rec2=0b rec3=030
        [0x0e] rec0=16 rec1=00 rec2=0c rec3=08e
        [0x0f] rec0=17 rec1=00 rec2=0d rec3=032
        [0x10] rec0=03 rec1=00 rec2=0e rec3=000
    tail 0x2170bb374822a62b6b4d8 0x42a00088462065003