⟦8d4f0621c⟧

TextFile

with Files;
with Lines;
with Names;
with Directory_Tools;
with String_Utilities;
package body Pathnames is

    Error : exception;

    -- ***** FUNDAMENTALS

    function Context return Full_Name is
    begin
        return ("!SOFTWARE_CATALOGS");
    end Context;

    function Catalogs_Context return Full_Name is
    begin
        return (Context & ".CATALOGS");
    end Catalogs_Context;

    function Defaults_Context return Full_Name is
    begin
        return (Context & ".DEFAULTS");
    end Defaults_Context;

    function Templates_Context return Full_Name is
    begin
        return (Context & ".TEMPLATES");
    end Templates_Context;

    -- **** TEMPORARY WORKSPACE

    function Workspace_For (This_Version : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Version) & ".DELETE_ME");
    end Workspace_For;

    -- ***** SIMPLE NAMES

    function Simple_Document_Setup_File_Name return Simple_Name is

    begin
        return ("DOCUMENT_SETUP_FILE");
    end Simple_Document_Setup_File_Name;

    function Simple_Printer_Options_File_Name return Simple_Name is
    begin
        return ("PRINTER_OPTIONS_FILE");
    end Simple_Printer_Options_File_Name;

    function Simple_Data_File_Name return Simple_Name is
    begin
        return ("DATA_FILE");
    end Simple_Data_File_Name;

    function Simple_Browser_Data_File_Name return Simple_Name is
    begin
        return ("BROWSER_DATA_FILE");
    end Simple_Browser_Data_File_Name;

    function Simple_Release_Notice_Name return Simple_Name is
    begin
        return ("RELEASE_NOTICE");
    end Simple_Release_Notice_Name;

    function Simple_Booklet_Name return Simple_Name is
    begin
        return ("BOOKLET");
    end Simple_Booklet_Name;

    function Simple_Public_Domain_Boilerplate_File_Name return Simple_Name is
    begin
        return ("PUBLIC_DOMAIN_COPYRIGHT_WARNING");
    end Simple_Public_Domain_Boilerplate_File_Name;

    function Simple_Proprietary_Boilerplate_File_Name return Simple_Name is
    begin
        return ("RATIONAL_COPYRIGHT_WARNING");
    end Simple_Proprietary_Boilerplate_File_Name;

    function Simple_Read_Me_File_Name return Simple_Name is
    begin
        return ("READ_ME");
    end Simple_Read_Me_File_Name;

    function Simple_Archive_Data_Name return Simple_Name is
    begin
        return ("DATA");
    end Simple_Archive_Data_Name;

    function Simple_Archive_Index_Name return Simple_Name is
    begin
        return ("INDEX");
    end Simple_Archive_Index_Name;

    function Simple_Parse_File_Name return Simple_Name is
    begin
        return ("PARSE_FILE");
    end Simple_Parse_File_Name;

    function Simple_Main_Procedure_Name return Simple_Name is
    begin
        return ("PARSED_MAIN_PROCEDURE");
    end Simple_Main_Procedure_Name;

    function Simple_Browser_View_Name_File_Name return Simple_Name is
    begin
        return ("BROWSER_VIEW_NAME");
    end Simple_Browser_View_Name_File_Name;

    function Simple_Load_Proc_Browser_Package_Name return Simple_Name is
    begin
        return ("BROWSER");
    end Simple_Load_Proc_Browser_Package_Name;

    function Simple_Load_Proc_Browser_Procedure_Name return Simple_Name is
    begin
        return ("BROWSE_CATALOG_IN");
    end Simple_Load_Proc_Browser_Procedure_Name;

    function Simple_Load_Proc_Name return Simple_Name is
    begin
        return ("BROWSE_CATALOG");
    end Simple_Load_Proc_Name;

    function Simple_Indirect_File_Name return Simple_Name is
    begin
        return ("INDIRECT_FILE");
    end Simple_Indirect_File_Name;

    -- **** TEMPLATES

    function Template_Suffix return String is
    begin
        return ("_TEMPLATE");
    end Template_Suffix;

    function Template_Name_From (This_Name : in Simple_Name) return Full_Name is
    begin
        return (Templates_Context & "." &
                String_Utilities.Upper_Case (This_Name) & Template_Suffix);
    end Template_Name_From;

    function Document_Setup_File_Template return Full_Name is
    begin
        return (Template_Name_From (Simple_Document_Setup_File_Name));
    end Document_Setup_File_Template;

    function Printer_Options_File_Template return Full_Name is
    begin
        return (Template_Name_From (Simple_Printer_Options_File_Name));
    end Printer_Options_File_Template;

    function Data_File_Template return Full_Name is
    begin
        return (Template_Name_From (Simple_Data_File_Name));
    end Data_File_Template;

    function Release_Notice_Template return Full_Name is
    begin
        return (Template_Name_From (Simple_Release_Notice_Name));
    end Release_Notice_Template;

    function Browser_View_Name_File_Template return Full_Name is
    begin
        return (Template_Name_From (Simple_Browser_View_Name_File_Name));
    end Browser_View_Name_File_Template;

    function Public_Domain_Boilerplate_File_Template return Full_Name is
    begin
        return (Template_Name_From
                   (Simple_Public_Domain_Boilerplate_File_Name));
    end Public_Domain_Boilerplate_File_Template;

    function Proprietary_Boilerplate_File_Template return Full_Name is
    begin
        return (Template_Name_From (Simple_Proprietary_Boilerplate_File_Name));
    end Proprietary_Boilerplate_File_Template;

    -- ***** MOVEMENT UP IN STRUCTURE

    function Catalogs_Context_Containing_Catalog
                (This_Catalog : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case
                   (Directory_Tools.Naming.Prefix (This_Catalog)));
    end Catalogs_Context_Containing_Catalog;

    function Catalog_Containing_Versions_Context
                (This_Versions_Context : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case
                   (Directory_Tools.Naming.Prefix (This_Versions_Context)));
    end Catalog_Containing_Versions_Context;

    function Versions_Context_Containing_Version
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case
                   (Directory_Tools.Naming.Prefix (This_Version)));
    end Versions_Context_Containing_Version;

    function Catalog_Containing_Version
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (Catalog_Containing_Versions_Context
                   (Versions_Context_Containing_Version (This_Version)));
    end Catalog_Containing_Version;

    function Catalog_Containing_Sections_Context
                (This_Sections_Context : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case
                   (Directory_Tools.Naming.Prefix (This_Sections_Context)));
    end Catalog_Containing_Sections_Context;

    function Sections_Context_Containing_Section
                (This_Section : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case
                   (Directory_Tools.Naming.Prefix (This_Section)));
    end Sections_Context_Containing_Section;

    function Catalog_Containing_Section
                (This_Section : in Full_Name) return Full_Name is
    begin
        return (Catalog_Containing_Sections_Context
                   (Sections_Context_Containing_Section (This_Section)));
    end Catalog_Containing_Section;

    function Section_Containing_Item
                (This_Item : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case
                   (Directory_Tools.Naming.Prefix (This_Item)));
    end Section_Containing_Item;

    function Catalog_Containing_Item
                (This_Item : in Full_Name) return Full_Name is
    begin
        return (Catalog_Containing_Section
                   (Section_Containing_Item (This_Item)));
    end Catalog_Containing_Item;

    -- ***** MOVEMENT DOWN IN STRUCTURE

    function Full_Catalog_Name  
                (This_Catalog : in Simple_Name) return Full_Name is
    begin
        return (Catalogs_Context & "." &
                String_Utilities.Upper_Case (This_Catalog));
    end Full_Catalog_Name;

    function Versions_Context_For
                (This_Catalog : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Catalog) & ".VERSIONS");
    end Versions_Context_For;

    function Full_Version_Name
                (This_Catalog : in Full_Name; This_Version : in Simple_Name)
                return Full_Name is
    begin
        return (Versions_Context_For (This_Catalog) & "." &
                String_Utilities.Upper_Case (This_Version));
    end Full_Version_Name;

    function Sections_Context_For
                (This_Catalog : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Catalog) & ".SECTIONS");
    end Sections_Context_For;

    function Full_Section_Name
                (This_Catalog : in Full_Name; This_Section : in Simple_Name)
                return Full_Name is
    begin
        return (Sections_Context_For (This_Catalog) & "." &
                String_Utilities.Upper_Case (This_Section));
    end Full_Section_Name;

    function Full_Item_Name
                (This_Section : in Full_Name; This_Item : in Simple_Name)
                return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Section) &
                "." & String_Utilities.Upper_Case (This_Item));
    end Full_Item_Name;

    function Full_View_Name
                (This_Item : in Full_Name; This_View : in Simple_Name)
                return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Item) & "." &
                String_Utilities.Upper_Case (This_View));
    end Full_View_Name;

    -- ***** VALIDITY TESTS

    -- All of the following validity tests work on the same principle:
    -- if the name is decomposed into its components by moving up
    -- in the structure, and these components are then put back together
    -- by moving back down in the structure, the result should be the
    -- identity operation. If not, the name was in some way invalid.

    procedure Assert_Is_Fully_Qualified (This_Name : in Full_Name) is
    begin
        if (not Names.Is_Fully_Qualified_Pathname (This_Name)) then
            raise Error;
        end if;
        --
    exception
        when others =>
            raise Error;
            --
    end Assert_Is_Fully_Qualified;

    function Is_Valid_Catalog_Name
                (This_Catalog : in Full_Name) return Boolean is
    begin  
        Assert_Is_Fully_Qualified (This_Catalog);
        return (Catalogs_Context_Containing_Catalog (This_Catalog) =
                Catalogs_Context);
        --
    exception
        when others =>
            return (False);
            --
    end Is_Valid_Catalog_Name;

    function Simple_Name_From (This_Name : in Full_Name) return Simple_Name is
    begin
        return (Directory_Tools.Naming.Simple_Name (This_Name));
    end Simple_Name_From;

    function Simple_Catalog_Name_From_Version
                (This_Version : in Full_Name) return Simple_Name is
    begin
        return (Simple_Name_From (Catalog_Containing_Version (This_Version)));
    end Simple_Catalog_Name_From_Version;

    function Simple_Catalog_Name_From_Section
                (This_Section : in Full_Name) return Simple_Name is
    begin
        return (Simple_Name_From (Catalog_Containing_Section (This_Section)));
    end Simple_Catalog_Name_From_Section;

    function Is_Valid_Version_Name
                (This_Version : in Full_Name) return Boolean is
    begin
        Assert_Is_Fully_Qualified (This_Version);
        return (Full_Version_Name
                   (This_Catalog =>
                       Full_Catalog_Name
                          (Simple_Catalog_Name_From_Version (This_Version)),
                    This_Version => Simple_Name_From (This_Version)) =
                String_Utilities.Upper_Case (This_Version));
        --
    exception
        when others =>
            return (False);
            --
    end Is_Valid_Version_Name;

    function Is_Valid_Section_Name
                (This_Section : in Full_Name) return Boolean is
    begin
        Assert_Is_Fully_Qualified (This_Section);
        return (Full_Section_Name
                   (This_Catalog =>
                       Full_Catalog_Name
                          (Simple_Catalog_Name_From_Section (This_Section)),
                    This_Section => Simple_Name_From (This_Section)) =
                String_Utilities.Upper_Case (This_Section));
        --
    exception
        when others =>
            return (False);
            --
    end Is_Valid_Section_Name;

    function Is_Valid_Item_Name (This_Item : in Full_Name) return Boolean is
    begin
        Assert_Is_Fully_Qualified (This_Item);
        return (Is_Valid_Section_Name (Section_Containing_Item (This_Item)));
        --
    exception
        when others =>
            return (False);
            --
    end Is_Valid_Item_Name;

    procedure Assert_Is_Valid_Catalog_Name (This_Catalog : in Full_Name) is
    begin
        if (not Is_Valid_Catalog_Name (This_Catalog)) then
            raise Invalid_Catalog_Name;
        end if;
    end Assert_Is_Valid_Catalog_Name;

    procedure Assert_Is_Valid_Version_Name (This_Version : in Full_Name) is
    begin
        if (not Is_Valid_Version_Name (This_Version)) then
            raise Invalid_Version_Name;
        end if;
    end Assert_Is_Valid_Version_Name;

    procedure Assert_Is_Valid_Section_Name (This_Section : in Full_Name) is
    begin
        if (not Is_Valid_Section_Name (This_Section)) then
            raise Invalid_Section_Name;
        end if;
    end Assert_Is_Valid_Section_Name;

    procedure Assert_Is_Valid_Item_Name (This_Item : in Full_Name) is
    begin
        if (not Is_Valid_Item_Name (This_Item)) then
            raise Invalid_Item_Name;
        end if;
    end Assert_Is_Valid_Item_Name;

    -- ***** VERSION-SPECIFIC OBJECTS

    function Version_Identifier_For
                (This_Version : in Full_Name) return Simple_Name is
    begin
        return (String_Utilities.Upper_Case
                   (Directory_Tools.Naming.Simple_Name (This_Version)));
    end Version_Identifier_For;

    function Data_File_For (This_Version : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Version) &
                "." & Simple_Data_File_Name);
    end Data_File_For;

    function Browser_Data_File_For
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Version) &
                "." & Simple_Browser_Data_File_Name);
    end Browser_Data_File_For;

    function Markup_Suffix return String is
    begin  
        return ("_MARKUP");
    end Markup_Suffix;

    function Browser_Data_File_Markup_File_For
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (Workspace_For (This_Version) & "." &
                Simple_Browser_Data_File_Name & Markup_Suffix);
    end Browser_Data_File_Markup_File_For;

    function Online_Suffix return String is
    begin  
        return ("_ONLINE");
    end Online_Suffix;

    function Browser_Data_File_Online_File_For
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (Browser_Data_File_Markup_File_For (This_Version) &
                Online_Suffix);
    end Browser_Data_File_Online_File_For;

    function Release_Notice_For
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Version) &
                "." & Simple_Release_Notice_Name);
    end Release_Notice_For;

    function Postscript_Indicator return Simple_Name is
    begin
        return ("_PS");
    end Postscript_Indicator;

    function Formatted_Release_Notice_For
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (Release_Notice_For (This_Version) & Postscript_Indicator);
    end Formatted_Release_Notice_For;

    function Booklet_For (This_Version : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Version) &
                "." & Simple_Booklet_Name);
    end Booklet_For;

    function Formatted_Booklet_For
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (Booklet_For (This_Version) & Postscript_Indicator);
    end Formatted_Booklet_For;

    -- ***** VIEW-SPECIFIC OBJECTS

    function Exports_File_For (This_View : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_View & ".STATE.EXPORTS"));
    end Exports_File_For;

    -- ***** BOILERPLATE FILES

    function Public_Domain_Boilerplate_File_For
                (This_View : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_View) & ".UNITS." &
                Simple_Public_Domain_Boilerplate_File_Name);
    end Public_Domain_Boilerplate_File_For;

    function Free_Form_Public_Domain_Boilerplate_File
                (For_Item : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (For_Item) & "." &
                Simple_Public_Domain_Boilerplate_File_Name);
    end Free_Form_Public_Domain_Boilerplate_File;

    function Proprietary_Boilerplate_File_For
                (This_View : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_View) & ".UNITS." &
                Simple_Proprietary_Boilerplate_File_Name);
    end Proprietary_Boilerplate_File_For;

    function Free_Form_Proprietary_Boilerplate_File
                (For_Item : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (For_Item) & "." &
                Simple_Proprietary_Boilerplate_File_Name);
    end Free_Form_Proprietary_Boilerplate_File;

    function All_Boilerplate_Files_In
                (This_View : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_View) & ".UNITS??.[" &
                Simple_Proprietary_Boilerplate_File_Name & ", " &
                Simple_Public_Domain_Boilerplate_File_Name & "]");
    end All_Boilerplate_Files_In;

    -- ***** READ_ME FILES

    function All_Read_Me_Files_In
                (This_Free_Form_Item : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Free_Form_Item) &
                ".[" & Simple_Read_Me_File_Name &
                ",@??." & Simple_Read_Me_File_Name & "]");
    end All_Read_Me_Files_In;

    function Read_Me_File_For (This_View : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_View) &
                ".UNITS." & Simple_Read_Me_File_Name);
    end Read_Me_File_For;

    -- ***** ARCHIVE OBJECTS

    function Archive_Data_For (This_Library : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Library) &
                "." & Simple_Archive_Data_Name);
    end Archive_Data_For;

    function Archive_Index_For (This_Library : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Library) &
                "." & Simple_Archive_Index_Name);
    end Archive_Index_For;

    -- ***** USER-SPECIFIC OBJECTS

    function User_Defaults_File_Indicator return String is
    begin
        return ("_DEFAULTS");
    end User_Defaults_File_Indicator;

    function Defaults_File_For (This_User : in User_Name) return Full_Name is
    begin
        return (Defaults_Context & "." &
                String_Utilities.Upper_Case (This_User) &
                User_Defaults_File_Indicator);
    end Defaults_File_For;

    -- ***** CONFIGURATION FILES

    function Printer_Options_File_For
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Version) &
                "." & Simple_Printer_Options_File_Name);
    end Printer_Options_File_For;

    function Document_Setup_File_For
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Version) &
                "." & Simple_Document_Setup_File_Name);
    end Document_Setup_File_For;

    -- ***** BROWSER AND LOAD-PROCS

    function Parse_File_Name_For
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (Workspace_For (This_Version) & "." & Simple_Parse_File_Name);
    end Parse_File_Name_For;

    function Main_Procedure_Name_For
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (Workspace_For (This_Version) &
                "." & Simple_Main_Procedure_Name);
    end Main_Procedure_Name_For;

    function Browser_View_Name_File_For
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Version) &
                "." & Simple_Browser_View_Name_File_Name);
    end Browser_View_Name_File_For;

    function Browser_View_Name_For
                (This_Version : in Full_Name) return Simple_Name is
    begin  
        return (Lines.Image
                   (Lines.Line_At (1,
                                   Files.Create (From_File =>
                                                    Browser_View_Name_File_For
                                                       (This_Version)))));
        --
    exception
        when others =>
            raise Io_Failure;
            --
    end Browser_View_Name_For;

    function Load_Proc_Browser_Package_Name_For
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (Sections_Context_For
                   (Catalog_Containing_Version (This_Version)) &
                ".SOFTWARE_CATALOG_TOOLS.SOFTWARE_CATALOG_TOOLS." &
                Browser_View_Name_For (This_Version) & ".UNITS.BROWSER." &
                Simple_Load_Proc_Browser_Package_Name);
    end Load_Proc_Browser_Package_Name_For;

    function Load_Proc_Name_For
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (String_Utilities.Upper_Case (This_Version) &
                "." & Simple_Load_Proc_Name);
    end Load_Proc_Name_For;

    -- ***** TAPES

    function Archive_Directives_File_For
                (This_Version : in Full_Name) return Full_Name is
    begin
        return (Workspace_For (This_Version) & "." & Simple_Indirect_File_Name);
    end Archive_Directives_File_For;

    function Tape_Contents_For (This_Version : in Full_Name) return String is
    begin
        return (String_Utilities.Upper_Case (This_Version) &
                ".[" & Simple_Browser_Data_File_Name & "," &
                Simple_Load_Proc_Name & "," & Simple_Archive_Index_Name &
                "," & Simple_Archive_Data_Name & "]");
    end Tape_Contents_For;

end Pathnames;
DataMuseum.dk

Rational R1000/400 Tapes

⟦8d4f0621c⟧ TextFile

Derivation

TextFile
