DataMuseum.dk

top - metrics - download

    Length: 7321 (0x1c99)
    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

separate (Browser)
procedure Extract_Item (This_Item : in Structure.Item;
                        Input : in out Window_Io.File_Type;
                        Output : in out Window_Io.File_Type;
                        The_Library : in Full_Name;
                        Response : in String) is

    Indent : constant String := "   ";

    Default_Column : constant Natural := Indent'Length + 1;

    First_Line : constant Natural := Natural'First;

    Current_Line : Natural := First_Line; -- State variable.

    procedure Reset_Line is
    begin
        Current_Line := First_Line;
    end Reset_Line;

    procedure Bump_Line (This_Much : in Natural := 1) is
    begin
        Window_Io.New_Line (Output, This_Much);
        Current_Line := Current_Line + This_Much;
    end Bump_Line;

    function Section_Containing
                (The_Item : in Structure.Item) return Full_Name is
    begin
        return (Structure.Full_Location_Of
                   (Structure.Section_Containing (The_Item)));
    end Section_Containing;

    function Prefix_For (The_Item : in Structure.Item) return Full_Name is
    begin
        loop  
            Reset_Line;
            Window_Utilities.Erase (Output);
            Editor.Window.Beginning_Of;
            Bump_Line (This_Much => 2);
            Window_Io.Insert
               (Output, Indent & "ENTER PATHNAME OF LIBRARY IN WHICH TO PLACE");
            Bump_Line;
            Window_Io.Insert (Output, Indent & "  """ &
                                         Structure.Name_Of (The_Item) & """");
            Bump_Line;
            Window_Io.Insert
               (Output,
                Indent &
                   "NOTE: ENTERING NULL STRING PLACES ITEM IN DEFAULT LOCATION");
            Bump_Line (This_Much => 3);
            declare
                The_Pathname : constant Full_Name :=
                   Window_Utilities.Query (Input_Window => Input,
                                           Output_Window => Output,
                                           Prompt => "LOCATION?: ",
                                           Line => Current_Line,
                                           Column => Default_Column);
            begin
                if (Directory_Tools.Naming.Is_Well_Formed (The_Pathname)) then
                    return (String_Utilities.Upper_Case (The_Pathname));  
                elsif (The_Pathname = "") then
                    return (Section_Containing (The_Item));
                else
                    Editor.Alert;
                    Bump_Line (This_Much => 1);
                    Window_Io.Insert (Output,
                                      "!! INVALID PATHNAME, PLEASE TRY AGAIN");
                    delay 2.0;
                end if;
            end;
        end loop;
    end Prefix_For;

    function Proceed_With_Extraction return Boolean is
    begin  
        Bump_Line (This_Much => 2);
        loop
            declare
                Proceed_Or_Abort : constant String :=
                   Window_Utilities.Query
                      (Input_Window => Input,
                       Output_Window => Output,
                       Prompt => "PROCEED OR ABORT? [P/A]: ",
                       Line => Current_Line,
                       Column => Default_Column);
            begin
                case (Proceed_Or_Abort (1)) is
                    when 'p' | 'P' =>  
                        return (True);
                    when 'a' | 'A' =>
                        return (False);
                    when others =>
                        Editor.Alert;
                end case;
                Editor.Alert;
                --
            exception
                when others =>
                    Editor.Alert;
                    --
            end;
        end loop;  
    end Proceed_With_Extraction;

    function Basic_Options return String is
    begin
        return ("R1000 BECOME_OWNER PRIMARY NEW_OBJECTS " &
                "WORLD_ACL=(Network_Public => RWCOD) " &
                "DEFAULT_ACL=(Network_Public => RW) " &
                "OBJECT_ACL=(Network_Public => RW) ");
    end Basic_Options;

    function Label_For (The_Item : in Structure.Item) return String is
    begin
        return ("LABEL=(" &
                Structure.Version_Of (Structure.Catalog_Containing (The_Item)) &
                ") ");
    end Label_For;

    function Has_Imports (The_Item : in Structure.Item) return Boolean is
        --
        The_Imports : Structure.Imports := Structure.Imports_For (The_Item);
        --
    begin  
        Structure.Reset (The_Imports);
        return (not Structure.Done (The_Imports));
    end Has_Imports;

    function Promote_Mode_For (The_Item : in Structure.Item) return String is
    begin
        case (Structure.Kind_Of (This_Item)) is
            when Syntax.Visible_Units | Syntax.Code_Only =>
                if (Has_Imports (The_Item)) then
                    return ("~PROMOTE");
                else
                    return ("PROMOTE");
                end if;
            when Syntax.Free_Form =>
                return ("~PROMOTE");
            when others =>
                null;
        end case;  
    end Promote_Mode_For;

    procedure Print_Imports_For (The_Item : in Structure.Item) is
    begin
        case (Structure.Kind_Of (This_Item)) is
            when Syntax.Visible_Units | Syntax.Code_Only =>
                if (Has_Imports (The_Item)) then
                    declare
                        The_Imports : Structure.Imports :=
                           Structure.Imports_For (The_Item);
                    begin
                        Log.Put_Line
                           ("Units were not automatically compiled because " &
                            "the following imports were required:");
                        Structure.Reset (The_Imports);
                        while (not Structure.Done (The_Imports)) loop
                            Log.Put_Line (Structure.Name_Of
                                             (Structure.Current_Object
                                                 (The_Imports)));
                            Structure.Next (The_Imports);
                        end loop;  
                        Log.Put_Line
                           ("NOTE: The imports listed above may be loaded " &
                            "on your machine in a different location, or " &
                            "may not be loaded at all");
                    end;
                end if;
            when others =>
                null;
        end case;  
    end Print_Imports_For;

begin
    declare
        The_Prefix : constant String := Prefix_For (This_Item);
    begin
        if (Proceed_With_Extraction) then
            Archive.Restore (Objects => Structure.Full_Location_Of (This_Item),
                             Use_Prefix => The_Prefix,
                             For_Prefix => Section_Containing (This_Item),
                             Options => Basic_Options & Label_For (This_Item) &
                                           Promote_Mode_For (This_Item),
                             Device => The_Library,
                             Response => "PROPAGATE," & Response);
            Print_Imports_For (This_Item);
        end if;
    end;
end Extract_Item;