DataMuseum.dk

top - metrics - download

    Length: 33003 (0x80eb)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

with Io;
with Names;
with Pathnames;
with Debug_Tools;
with String_Utilities;
with Annotations_Generic;
with Misc_String_Utilities;
with Low_Level_File_Operations;
package body Structure is

    -- ***** RENAMES:

    function "=" (This_Section_Kind : in Syntax.Section_Kinds;  
                  That_Section_Kind : in Syntax.Section_Kinds)  
                 return Boolean renames Syntax."=";

    function "=" (This_Item_Kind : in Syntax.Item_Kinds;
                  That_Item_Kind : in Syntax.Item_Kinds) return Boolean
        renames Syntax."=";

    function "=" (This_Import_Value : in Syntax.Booleans;
                  That_Import_Value : in Syntax.Booleans) return Boolean
        renames Syntax."=";

    -- ***** COMPLETIONS OF TRULY-PRIVATE TYPES:

    type Message_Node is
        record
            Kind : Diagnostics := Progress;
            Contents : Lines.Line := Lines.Empty_Line;
        end record;

    type Object_Node is
        record
            Name : Lines.Line := Lines.Empty_Line;
            Actual_Object : Physical_Object := Directory_Tools.Object.Nil;
        end record;

    type Item_Node is  
        record
            Name : Lines.Line := Lines.Empty_Line;
            Location : Lines.Line := Lines.Empty_Line;
            Description : Text := Text (Lines.Create);
            Kind : Syntax.Item_Kinds := Syntax.Visible_Units;
            Imports : Object_List := Object_List (Object_Lists.Create);
            Spec_Views : Object_List := Object_List (Object_Lists.Create);
            Load_Views : Object_List := Object_List (Object_Lists.Create);
            Is_Proprietary : Syntax.Booleans := Syntax.True;
            Parent : Section := null;
            Actual_Item : Physical_Object := Directory_Tools.Object.Nil;
        end record;

    type Section_Node is  
        record
            Name : Lines.Line := Lines.Empty_Line;
            Location : Lines.Line := Lines.Empty_Line;
            Description : Text := Text (Lines.Create);
            Kind : Syntax.Section_Kinds := Syntax.Items;  
            Items : Item_Lists.List := Item_Lists.Create;
            Parent : Catalog := null;
            Actual_Section : Physical_Object := Directory_Tools.Object.Nil;
        end record;

    type Catalog_Node is  
        record
            Name : Lines.Line := Lines.Empty_Line;
            Version : Lines.Line := Lines.Empty_Line;
            Location : Lines.Line := Lines.Empty_Line;
            Description : Text := Text (Lines.Create);
            Sections : Section_Lists.List := Section_Lists.Create;
            Is_Good : Boolean := False;
            The_Diagnostic : Diagnostic := Diagnostic (Message_Lists.Create);
            The_Data_File : Data_File := Data_File (Lines.Create);
            Allowable_Models : Object_List := Object_List (Object_Lists.Create);
            Allowable_Links : Object_List := Object_List (Object_Lists.Create);
            Actual_Catalog : Physical_Object := Directory_Tools.Object.Nil;
        end record;

    -- ***** MISCELLANEOUS DECLARATIONS:

    type Filtration_State is -- Used in filtering function below.
        record
            Filtered_Catalog : Catalog := null;
            Filtered_Section : Section := null;
            Filtered_Item : Item := null;  
        end record;

    -- Used in "Catalog_For" subunit only, but is declared here so
    -- need not be re-elaborated each time "Catalog_For" is called.

    package Annotations is new Annotations_Generic (Syntax.Annotation_Indicator,  
                                                    Syntax.Argument_Delimiter,  
                                                    Syntax.Comment_Keywords,  
                                                    Syntax.Valued_Keywords);
    -- ***** SELECTORS AND ITERATORS:

    -- LINE:

    function Contents_Of (This_Line : in Line) return String is
    begin
        return (Lines.Image (Lines.Line (This_Line)));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Contents_Of;

    -- TEXT:

    procedure Reset (This_Text : in out Text) is
    begin
        Lines.Reset (Lines.Iterator (This_Text));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Reset;

    function Current_Line (This_Text : in Text) return Line is
    begin
        return (Line (Lines.Current (Lines.Iterator (This_Text))));
        --
    exception  
        when Lines.No_Current_Line =>
            raise No_Current_Element;
        when others =>
            raise Bad_Element;
            --
    end Current_Line;

    function Done (This_Text : in Text) return Boolean is
    begin
        return (Lines.Done (Lines.Iterator (This_Text)));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Done;

    procedure Next (This_Text : in out Text) is
    begin
        Lines.Next (Lines.Iterator (This_Text));
        --
    exception  
        when Lines.No_Next_Line =>
            raise No_Next_Element;
        when others =>
            raise Bad_Element;
            --
    end Next;

    -- MESSAGE:

    function Kind_Of (This_Message : in Message) return Diagnostics is
    begin
        return (This_Message.Kind);
    end Kind_Of;

    function Contents_Of (This_Message : in Message) return String is
    begin
        return (Lines.Image (This_Message.Contents));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Contents_Of;

    -- DIAGNOSTIC:

    procedure Reset (This_Diagnostic : in out Diagnostic) is
    begin
        Message_Lists.Reset (Message_Lists.List (This_Diagnostic));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Reset;

    function Current_Message (This_Diagnostic : in Diagnostic) return Message is
    begin
        return (Message_Lists.Current (Message_Lists.List (This_Diagnostic)));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Current_Message;

    function Done (This_Diagnostic : in Diagnostic) return Boolean is
    begin
        return (Message_Lists.Done (Message_Lists.List (This_Diagnostic)));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Done;

    procedure Next (This_Diagnostic : in out Diagnostic) is
    begin
        Message_Lists.Next (Message_Lists.List (This_Diagnostic));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Next;

    -- OBJECT:

    function Name_Of (This_Object : in Object) return Full_Name is
    begin
        return (Lines.Image (Lines.Line (This_Object.Name)));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Name_Of;

    function Simple_Name_Of (This_Object : in Object) return Simple_Name is
    begin
        return (Directory_Tools.Naming.Simple_Name (Name_Of (This_Object)));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Simple_Name_Of;

    function Actual_Object_For
                (This_Object : in Object) return Physical_Object is
    begin
        if (not Directory_Tools.Object.Is_Bad (This_Object.Actual_Object)) then
            return (This_Object.Actual_Object);
        else  
            This_Object.Actual_Object :=
               Directory_Tools.Naming.Resolution (Name_Of (This_Object));
            return (This_Object.Actual_Object);
        end if;
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Actual_Object_For;

    -- OBJECT LISTS:

    procedure Reset (This_Object_List : in out Object_List) is
    begin
        Object_Lists.Reset (Object_Lists.List (This_Object_List));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Reset;

    function Current_Object (This_Object_List : in Object_List) return Object is
    begin
        return (Object_Lists.Current (Object_Lists.List (This_Object_List)));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Current_Object;

    function Done (This_Object_List : in Object_List) return Boolean is
    begin
        return (Object_Lists.Done (Object_Lists.List (This_Object_List)));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Done;

    procedure Next (This_Object_List : in out Object_List) is
    begin
        Object_Lists.Next (Object_Lists.List (This_Object_List));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Next;

    -- ITEM:

    function Name_Of (This_Item : in Item) return String is
    begin
        Assert_Is_Good (Catalog_Containing (This_Item));
        return (Lines.Image (This_Item.Name));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Name_Of;

    function Kind_Of (This_Item : in Item) return Syntax.Item_Kinds is
    begin
        Assert_Is_Good (Catalog_Containing (This_Item));
        return (This_Item.Kind);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Kind_Of;

    procedure Assert_Is_Valid_Kind (This_Item : in Item) is
    begin
        case (Kind_Of (This_Item)) is
            when Syntax.Environment =>
                raise Invalid_Item_Kind;
            when others =>
                null;
        end case;
    end Assert_Is_Valid_Kind;

    function Location_Of (This_Item : in Item) return Simple_Name is
    begin
        Assert_Is_Good (Catalog_Containing (This_Item));
        Assert_Is_Valid_Kind (This_Item);
        return (Lines.Image (This_Item.Location));
        --
    exception
        when Invalid_Item_Kind =>
            raise;
        when others =>
            raise Bad_Element;
            --
    end Location_Of;

    function Full_Location_Of (This_Item : in Item) return Full_Name is
    begin
        Assert_Is_Good (Catalog_Containing (This_Item));
        Assert_Is_Valid_Kind (This_Item);
        return (Pathnames.Full_Item_Name
                   (This_Section => Full_Location_Of
                                       (Section_Containing (This_Item)),
                    This_Item => Location_Of (This_Item)));
        --
    exception
        when Invalid_Item_Kind =>
            raise;
        when others =>
            raise Bad_Element;
            --
    end Full_Location_Of;

    function Imports_For (This_Item : in Item) return Imports is
    begin
        Assert_Is_Good (Catalog_Containing (This_Item));
        Assert_Is_Valid_Kind (This_Item);
        return (This_Item.Imports);
        --
    exception
        when Invalid_Item_Kind =>
            raise;
        when others =>
            raise Bad_Element;
            --
    end Imports_For;

    function Spec_Views_For (This_Item : in Item) return Spec_Views is
    begin
        Assert_Is_Good (Catalog_Containing (This_Item));
        Assert_Is_Valid_Kind (This_Item);
        return (This_Item.Spec_Views);
        --
    exception
        when Invalid_Item_Kind =>
            raise;
        when others =>
            raise Bad_Element;
            --
    end Spec_Views_For;

    function Load_Views_For (This_Item : in Item) return Load_Views is
    begin
        Assert_Is_Good (Catalog_Containing (This_Item));
        Assert_Is_Valid_Kind (This_Item);
        return (This_Item.Load_Views);
        --
    exception
        when Invalid_Item_Kind =>
            raise;
        when others =>
            raise Bad_Element;
            --
    end Load_Views_For;

    function Is_Proprietary (This_Item : in Item) return Boolean is
    begin
        Assert_Is_Good (Catalog_Containing (This_Item));
        Assert_Is_Valid_Kind (This_Item);
        return (This_Item.Is_Proprietary = Syntax.True);
        --
    exception
        when Invalid_Item_Kind =>
            raise;
        when others =>
            raise Bad_Element;
            --
    end Is_Proprietary;

    function Description_Of (This_Item : in Item) return Text is
    begin
        Assert_Is_Good (Catalog_Containing (This_Item));
        return (This_Item.Description);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Description_Of;

    function Section_Containing (This_Item : in Item) return Section is
    begin  
        Assert_Is_Good (This_Item.Parent.Parent);
        return (This_Item.Parent);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Section_Containing;

    function Catalog_Containing (This_Item : in Item) return Catalog is
    begin  
        Assert_Is_Good (This_Item.Parent.Parent);
        return (This_Item.Parent.Parent);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Catalog_Containing;

    function Actual_Item_For (This_Item : in Item) return Physical_Object is
    begin
        if (Directory_Tools.Object.Is_Bad (This_Item.Actual_Item)) then
            This_Item.Actual_Item := Directory_Tools.Naming.Resolution
                                        (Full_Location_Of (This_Item));
        end if;
        return (This_Item.Actual_Item);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Actual_Item_For;

    -- ITEMS:

    procedure Reset (This_Section : in out Section) is
    begin
        Assert_Is_Good (Catalog_Containing (This_Section));
        Item_Lists.Reset (This_Section.Items);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Reset;

    function Current_Item (This_Section : in Section) return Item is
    begin
        Assert_Is_Good (Catalog_Containing (This_Section));
        return (Item_Lists.Current (This_Section.Items));
        --
    exception  
        when Item_Lists.No_Current_Element =>
            raise No_Current_Element;
        when others =>
            raise Bad_Element;
            --
    end Current_Item;

    function Done (This_Section : in Section) return Boolean is
    begin
        Assert_Is_Good (Catalog_Containing (This_Section));
        return (Item_Lists.Done (This_Section.Items));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Done;

    procedure Next (This_Section : in out Section) is
    begin
        Assert_Is_Good (Catalog_Containing (This_Section));
        Item_Lists.Next (This_Section.Items);
        --
    exception  
        when Item_Lists.No_Next_Element =>
            raise No_Next_Element;
        when others =>
            raise Bad_Element;
            --
    end Next;

    -- SECTION:

    function Name_Of (This_Section : in Section) return String is
    begin
        Assert_Is_Good (Catalog_Containing (This_Section));
        return (Lines.Image (This_Section.Name));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Name_Of;

    function Kind_Of (This_Section : in Section)  
                     return Syntax.Section_Kinds is
    begin
        Assert_Is_Good (Catalog_Containing (This_Section));
        return (This_Section.Kind);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Kind_Of;

    function Location_Of (This_Section : in Section) return Simple_Name is
    begin
        Assert_Is_Good (Catalog_Containing (This_Section));
        return (Lines.Image (This_Section.Location));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Location_Of;

    function Full_Location_Of (This_Section : in Section) return Full_Name is
    begin
        Assert_Is_Good (Catalog_Containing (This_Section));
        return (Pathnames.Full_Section_Name
                   (This_Catalog => Full_Location_Of
                                       (Catalog_Containing (This_Section)),
                    This_Section => Location_Of (This_Section)));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Full_Location_Of;

    function Description_Of (This_Section : in Section) return Text is
    begin
        Assert_Is_Good (Catalog_Containing (This_Section));
        return (This_Section.Description);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Description_Of;

    function Catalog_Containing (This_Section : in Section) return Catalog is
    begin
        Assert_Is_Good (This_Section.Parent);
        return (This_Section.Parent);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Catalog_Containing;

    function Actual_Section_For
                (This_Section : in Section) return Physical_Object is
    begin
        if (Kind_Of (This_Section) = Syntax.Text) then
            raise Invalid_Section_Kind;
        end if;
        if (Directory_Tools.Object.Is_Bad (This_Section.Actual_Section)) then
            This_Section.Actual_Section := Directory_Tools.Naming.Resolution
                                              (Full_Location_Of (This_Section));
        end if;
        return (This_Section.Actual_Section);
        --
    exception
        when Invalid_Section_Kind =>
            raise;
        when others =>
            raise Bad_Element;
            --
    end Actual_Section_For;

    -- SECTIONS:

    procedure Reset (This_Catalog : in out Catalog) is
    begin
        Assert_Is_Good (This_Catalog);
        Section_Lists.Reset (This_Catalog.Sections);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Reset;

    function Current_Section (This_Catalog : in Catalog) return Section is
    begin
        Assert_Is_Good (This_Catalog);
        return (Section_Lists.Current (This_Catalog.Sections));
        --
    exception
        when Section_Lists.No_Current_Element =>
            raise No_Current_Element;
        when others =>
            raise Bad_Element;
            --
    end Current_Section;

    function Done (This_Catalog : in Catalog) return Boolean is
    begin
        Assert_Is_Good (This_Catalog);
        return (Section_Lists.Done (This_Catalog.Sections));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Done;

    procedure Next (This_Catalog : in out Catalog) is
    begin
        Assert_Is_Good (This_Catalog);
        Section_Lists.Next (This_Catalog.Sections);
        --
    exception  
        when Section_Lists.No_Next_Element =>
            raise No_Next_Element;
        when others =>
            raise Bad_Element;
            --
    end Next;

    -- CATALOG:

    function Name_Of (This_Catalog : in Catalog) return String is
    begin
        Assert_Is_Good (This_Catalog);
        return (Lines.Image (This_Catalog.Name));
    exception
        when others =>
            raise Bad_Element;
    end Name_Of;

    function Version_Of (This_Catalog : in Catalog) return Simple_Name is
    begin
        Assert_Is_Good (This_Catalog);
        return (Lines.Image (This_Catalog.Version));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Version_Of;

    function Full_Version_Of (This_Catalog : in Catalog) return Full_Name is
    begin
        return (Pathnames.Full_Version_Name
                   (This_Catalog => Full_Location_Of (This_Catalog),
                    This_Version => Version_Of (This_Catalog)));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Full_Version_Of;

    function Location_Of (This_Catalog : in Catalog) return Simple_Name is
    begin
        Assert_Is_Good (This_Catalog);
        return (Lines.Image (This_Catalog.Location));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Location_Of;

    function Full_Location_Of (This_Catalog : in Catalog) return Full_Name is
    begin
        Assert_Is_Good (This_Catalog);
        return (Pathnames.Full_Catalog_Name (Location_Of (This_Catalog)));
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Full_Location_Of;

    function Description_Of (This_Catalog : in Catalog) return Text is
    begin
        Assert_Is_Good (This_Catalog);
        return (This_Catalog.Description);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Description_Of;

    function Allowable_Models_For
                (This_Catalog : in Catalog) return Allowable_Models is
    begin
        Assert_Is_Good (This_Catalog);
        return (This_Catalog.Allowable_Models);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Allowable_Models_For;

    function Allowable_Links_For
                (This_Catalog : in Catalog) return Allowable_Links is
    begin
        Assert_Is_Good (This_Catalog);
        return (This_Catalog.Allowable_Links);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Allowable_Links_For;

    function Actual_Catalog_For
                (This_Catalog : in Catalog) return Physical_Object is
    begin  
        if (Directory_Tools.Object.Is_Bad (This_Catalog.Actual_Catalog)) then
            This_Catalog.Actual_Catalog := Directory_Tools.Naming.Resolution
                                              (Full_Location_Of (This_Catalog));
        end if;
        return (This_Catalog.Actual_Catalog);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Actual_Catalog_For;

    -- **** CONSTRUCTORS:

    function Catalog_From (This_Data_File : in Full_Name)
                          return Catalog is separate;

    procedure Traverse (This_Catalog : in Catalog;
                        This_State : in out State) is separate;

    function Copy_Message (This_Message : in Message) return Message is
        --
        The_Copy : Message := new Message_Node;
        --
    begin
        The_Copy.Kind := This_Message.Kind;
        The_Copy.Contents := Lines.Copy (This_Message.Contents);
        return (The_Copy);
    end Copy_Message;

    function Copy_List is new Message_Lists.Copy (Copy_Message);

    function Copy_Diagnostic
                (This_Diagnostic : in Diagnostic) return Diagnostic is
    begin
        return (Diagnostic (Copy_List (Message_Lists.List (This_Diagnostic))));
    end Copy_Diagnostic;

    function Copy_Object (This_Object : in Object) return Object is
        --
        The_Copy : Object := new Object_Node;
        --
    begin
        The_Copy.Name := Lines.Copy (This_Object.Name);
        The_Copy.Actual_Object := This_Object.Actual_Object;
        return (The_Copy);
    end Copy_Object;

    function Copy_List is new Object_Lists.Copy (Copy_Object);

    function Copy_Object_List
                (This_Object_List : in Object_List) return Object_List is
    begin
        return (Object_List (Copy_List (Object_Lists.List (This_Object_List))));
    end Copy_Object_List;

    function Filtered_Version_Of
                (This_Catalog : in Catalog) return Catalog is separate;

    function Dont_Want (This_Section : in Section) return Boolean is
    begin
        return (False);
    end Dont_Want;

    function Dont_Want (This_Item : in Item) return Boolean is
    begin
        return (False);
    end Dont_Want;

    function Copy is new Filtered_Version_Of (Dont_Want, Dont_Want);

    function Copy_Of (This_Catalog : in Catalog) return Catalog is
    begin
        return (Copy (This_Catalog));
    end Copy_Of;

    procedure Save_Line (This_Keyword : in Syntax.Valued_Keywords;
                         This_Argument : in String;
                         To_This_File : in out Io.File_Type) is
    begin
        Io.Put_Line (To_This_File,
                     Syntax.Annotation_Indicator &
                        Syntax.Valued_Keywords'Image (This_Keyword) &
                        Syntax.Argument_Delimiter & This_Argument);
    end Save_Line;

    procedure Save_Text (This_Text : in Text;
                         To_This_File : in out Io.File_Type) is
        --
        The_Text : Text := This_Text;
        --
    begin
        Reset (The_Text);
        while (not Done (The_Text)) loop
            Io.Put_Line (To_This_File,  
                         Contents_Of (Current_Line (The_Text)));
            Next (The_Text);
        end loop;
    end Save_Text;

    procedure Save_Object_List (This_Keyword : in Syntax.Valued_Keywords;
                                This_Object_List : in Object_List;
                                To_This_File : in out Io.File_Type;
                                Force_Simple : in Boolean := False) is
        --
        Annotation : constant String :=
           Syntax.Annotation_Indicator &
              Syntax.Valued_Keywords'Image (This_Keyword) &
              Syntax.Argument_Delimiter;
        --
        The_Object_List : Object_List := This_Object_List;
        --
    begin
        Reset (The_Object_List);
        while (not Done (The_Object_List)) loop
            if (Force_Simple) then
                Io.Put_Line (To_This_File,
                             Annotation & Simple_Name_Of
                                             (Current_Object
                                                 (The_Object_List)));
            else
                Io.Put_Line (To_This_File,
                             Annotation & Name_Of (Current_Object
                                                      (The_Object_List)));
            end if;
            Next (The_Object_List);
        end loop;
    end Save_Object_List;

    procedure Save_Header (This_Catalog : in Catalog;
                           To_This_File : in out Io.File_Type) is
    begin
        Save_Line (Syntax.Catalog, Name_Of (This_Catalog), To_This_File);
        Save_Line (Syntax.Location, Location_Of (This_Catalog), To_This_File);
        Save_Line (Syntax.Version, Version_Of (This_Catalog), To_This_File);
    end Save_Header;

    procedure Save_Catalog (This_Catalog : in Catalog;
                            To_This_File : in out Io.File_Type;
                            Control_Result : out Traversal_Control) is
    begin
        Save_Header (This_Catalog, To_This_File);
        Save_Text (This_Catalog.Description, To_This_File);
        Control_Result := Continue;
    end Save_Catalog;

    procedure Save_Header (This_Section : in Section;
                           To_This_File : in out Io.File_Type) is
    begin
        Save_Line (Syntax.Section, Name_Of (This_Section), To_This_File);
        Save_Line (Syntax.Kind,
                   Syntax.Section_Kinds'Image (Kind_Of (This_Section)),
                   To_This_File);
        if (Kind_Of (This_Section) /= Syntax.Text) then
            Save_Line (Syntax.Location,
                       Location_Of (This_Section), To_This_File);
        end if;
    end Save_Header;

    procedure Save_Section (This_Section : in Section;
                            To_This_File : in out Io.File_Type;
                            Control_Result : out Traversal_Control) is
    begin
        Save_Header (This_Section, To_This_File);
        Save_Text (This_Section.Description, To_This_File);
        Control_Result := Continue;
    end Save_Section;

    procedure Save_Header (This_Item : in Item;
                           To_This_File : in out Io.File_Type) is
    begin
        Save_Line (Syntax.Item, Name_Of (This_Item), To_This_File);
        Save_Line (Syntax.Kind, Syntax.Item_Kinds'Image (Kind_Of (This_Item)),
                   To_This_File);
        if (Kind_Of (This_Item) /= Syntax.Environment) then
            Save_Line (Syntax.Location, Location_Of (This_Item), To_This_File);
            Save_Object_List (Syntax.Import, This_Item.Imports, To_This_File);
            Save_Object_List (Syntax.Spec_View,
                              This_Item.Spec_Views, To_This_File,
                              Force_Simple => True);
            Save_Object_List (Syntax.Load_View,
                              This_Item.Load_Views, To_This_File,
                              Force_Simple => True);
            Save_Line (Syntax.Proprietary,
                       Boolean'Image (Is_Proprietary (This_Item)),
                       To_This_File);
        end if;
    end Save_Header;

    procedure Save_Item (This_Item : in Item;
                         To_This_File : in out Io.File_Type;
                         Control_Result : out Traversal_Control) is
    begin
        Save_Header (This_Item, To_This_File);
        Save_Text (This_Item.Description, To_This_File);
        Control_Result := Continue;
    end Save_Item;

    procedure Save_Trailer (This_Catalog : in Catalog;
                            To_This_File : in out Io.File_Type) is
    begin
        Save_Object_List
           (Syntax.Model, This_Catalog.Allowable_Models, To_This_File);
        Save_Object_List
           (Syntax.Link, This_Catalog.Allowable_Links, To_This_File);
    end Save_Trailer;

    procedure Save_Model_And_Link_Information
                 (This_Catalog : in Catalog;
                  To_This_File : in out Io.File_Type) is
    begin
        Save_Trailer (This_Catalog, To_This_File);
        Low_Level_File_Operations.Close (To_This_File);
    end Save_Model_And_Link_Information;

    procedure Traverse_And_Save is
       new Traverse (Io.File_Type,  
                     Save_Catalog,  
                     Save_Section,  
                     Save_Item,  
                     Save_Model_And_Link_Information);

    procedure Save (This_Catalog : in Catalog; To_This_File : in Full_Name) is
        --
        The_File : Io.File_Type;
        --
    begin
        declare
            The_Catalog : Catalog := This_Catalog;
        begin
            The_File := Low_Level_File_Operations.Open_To_Write (To_This_File);
            Traverse_And_Save (The_Catalog, The_File);
        end;
        --
    exception
        when Bad_Element =>
            raise;
        when Low_Level_File_Operations.Io_Failure =>
            raise Io_Failure;
            --
    end Save;

    procedure Set_Version_Of (This_Data_File : in Full_Name;
                              To_This_Version : in Simple_Name) is
    begin
        declare
            --
            The_Original_Data_File : Files.Iterator :=
               Files.Create (This_Data_File);
            --
            The_Modified_Data_File : Io.File_Type :=
               Low_Level_File_Operations.Open_To_Write (This_Data_File);
            --
        begin
            Lines.Reset (The_Original_Data_File);
            while (not Lines.Done (The_Original_Data_File)) loop
                declare
                    Current_Line : Lines.Line :=
                       Lines.Current (The_Original_Data_File);
                begin
                    if (Annotations.Keywords_Match
                           (Current_Line, Syntax.Version)) then
                        Save_Line (Syntax.Version,  
                                   To_This_Version,  
                                   The_Modified_Data_File);
                    else
                        Io.Put_Line (The_Modified_Data_File,
                                     Lines.Image (Current_Line));
                    end if;
                end;
                Lines.Next (The_Original_Data_File);
            end loop;
            Low_Level_File_Operations.Close (The_Modified_Data_File);
        end;
        --
    exception
        when others =>
            raise Io_Failure;
            --
    end Set_Version_Of;

    -- DIAGNOSTICS:

    function Is_Good (This_Catalog : in Catalog) return Boolean is
    begin
        return (This_Catalog.Is_Good);
    end Is_Good;

    procedure Assert_Is_Good (This_Catalog : in Catalog) is
    begin
        if (not Is_Good (This_Catalog)) then
            raise Bad_Element;
        end if;
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Assert_Is_Good;

    function Diagnostic_For (This_Catalog : in Catalog) return Diagnostic is
    begin  
        return (This_Catalog.The_Diagnostic);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Diagnostic_For;

    function Diagnostic_For (This_Catalog : in Catalog) return Data_File is
    begin
        return (This_Catalog.The_Data_File);
        --
    exception
        when others =>
            raise Bad_Element;
            --
    end Diagnostic_For;

end Structure;