DataMuseum.dk

top - download

    Length: 7047 (0x1b87)
    Types: TextFile
    Names: »B«

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

-------------------------------------------------------------------------------
with Umps_Defs;
with Wild_String;  
with Slot;
with Set;
with Text_Io;


package body Notice is

    Tabulation : constant String (1 .. 15) := (others => ' ');


    ---------------------------------------------------------------------------
    procedure Add_Sender (Behavior :        Umps_Defs.Behavior_Number;
                          Into     : in out Element) is

    begin
        Into.Sender := Behavior;
    end Add_Sender;

    ---------------------------------------------------------------------------
    procedure Add_Handler (Behavior :        Umps_Defs.Behavior_Number;
                           Into     : in out Element) is

    begin
        Into.Handler := Behavior;
    end Add_Handler;

    ---------------------------------------------------------------------------
    procedure Add_Class (Class : String; Into : in out Element) is

    begin  
        if (not Set.Is_Empty (Into.Params)) then
            Set.Free (Into.Params);
        end if;
        Into.Class := Umps_Defs.Normalize (The_Name => Class);
    end Add_Class;

    ---------------------------------------------------------------------------
    procedure Add_Id (Id : String; Into : in out Element) is

    begin
        if (not Set.Is_Empty (Into.Params)) then
            Set.Free (Into.Params);
        end if;
        Into.Id := Umps_Defs.Normalize (The_Name => Id);
    end Add_Id;

    ---------------------------------------------------------------------------
    procedure Add_Params (Params : Set.Object; Into : in out Element) is
        function  Is_Name_Less is new Slot.Is_Less (Field => Slot.On_Name);
        procedure Sort_All     is new Set.Sort ("<" => Is_Name_Less);

    begin  
        Into.Params := Params;
        Sort_All (Into.Params);
    end Add_Params;

    ---------------------------------------------------------------------------
    procedure Add_Param (Param : Slot.Element; Into : in out Element) is
        function  Is_Name_Less is new Slot.Is_Less (Field => Slot.On_Name);
        procedure Sort_All     is new Set.Sort ("<" => Is_Name_Less);

    begin  
        Into.Params := Set.Add (Param, Into => Into.Params);
        Sort_All (Into.Params);
    end Add_Param;

    ---------------------------------------------------------------------------
    function Sender (Of_The_Element : Element)
                    return Umps_Defs.Behavior_Number is

    begin
        return Of_The_Element.Sender;
    end Sender;

    ---------------------------------------------------------------------------
    function Handler (Of_The_Element : Element)
                     return Umps_Defs.Behavior_Number is

    begin
        return Of_The_Element.Handler;
    end Handler;

    ---------------------------------------------------------------------------
    function Params (Of_The_Element : Element) return Set.Object is

    begin
        return Of_The_Element.Params;
    end Params;

    ---------------------------------------------------------------------------
    function Param (Of_The_Element : Element; With_Name : String)
                   return Slot.Element is
        The_Element : Slot.Element;
        Iter        : Set.Iterator;

    begin
        Set.Init (Iter, Of_The_Element.Params);
        while (not Set.Done (Iter, Of_The_Element.Params)) loop
            The_Element := Set.Value (Iter, Of_The_Element.Params);
            if (Slot.Name_Of (The_Element) = With_Name) then
                return The_Element;
            end if;
            Set.Next (Iter, Of_The_Element.Params);
        end loop;  
        return Slot.Make ("", Slot.Void);
    end Param;

    ---------------------------------------------------------------------------
    function Class (Of_The_Element : Element) return String is

    begin
        return Umps_Defs.Denormalize (Of_The_Element.Class);
    end Class;

    ---------------------------------------------------------------------------
    function Id (Of_The_Element : Element) return String is

    begin
        return Umps_Defs.Denormalize (Of_The_Element.Id);
    end Id;

    ---------------------------------------------------------------------------
    function Image (The_Element : Element) return String is
        function Image_Of is new Set.Image (Separator, Image => Slot.Image);

    begin
        return Umps_Defs.Behavior_Number'Image (Sender (The_Element)) &
                  Separator &
                  Umps_Defs.Behavior_Number'Image (Handler (The_Element)) &
                  Separator &
                  Class (The_Element) &
                  Separator &
                  Id (The_Element) &
                  Separator &
                  Image_Of (Params (The_Element));
    end Image;

    ---------------------------------------------------------------------------
    procedure Display (The_Element : Element; String_Before : String := "") is
        procedure Display_All is new Set.Display (Display => Slot.Display);

    begin
        Text_Io.Put_Line (String_Before & "Class => " & Umps_Defs.Class_Notice);
        Text_Io.Put_Line (String_Before & "   Sender  => " &
                          Umps_Defs.Behavior_Number'Image
                             (Sender (The_Element)));
        Text_Io.Put_Line (String_Before & "   Handler => " &
                          Umps_Defs.Behavior_Number'Image
                             (Handler (The_Element)));
        Text_Io.Put_Line (String_Before & "       Op Code    => " &
                          Class (The_Element));
        Text_Io.Put_Line (String_Before & "       Id         => " &
                          Id (The_Element));
        Text_Io.Put_Line (String_Before & "       Parameters => ");
        Display_All (Params (The_Element), String_Before & Tabulation);
    end Display;

    ---------------------------------------------------------------------------
    function Is_Equal (Left, Right : Element) return Boolean is
        The_Same : Boolean;

    begin
        The_Same := Sender (Left) = Sender (Right) and then
                       Handler (Left) = Handler (Right) and then
                       Wild_String.Is_Equal (Class (Left),
                                             Class (Right)) and then
                       Wild_String.Is_Equal (Id (Left), Id (Right));
        if not The_Same then
            return False;
        elsif (Slot."=" (Field, Slot.On_None)) then
            return True;
        else
            Compare_Parameters:
                declare
                    function Is_Field_Equal  is
                       new Slot.Is_Equal (Field => Field);
                    function Is_Object_Equal is
                       new Set.Is_Equal (Is_Equal => Is_Field_Equal);
                begin
                    return Is_Object_Equal (Params (Right), Params (Left));
                end Compare_Parameters;
        end if;
    end Is_Equal;


end Notice;
-------------------------------------------------------------------------------