DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦482563444⟧ TextFile

    Length: 8093 (0x1f9d)
    Types: TextFile
    Names: »B«

Derivation

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Bit_Ops;
with Communications;
with Errors;
with Files;
with Files;
with Interchange;
with Mac_Files;  
with Mac_Path;
with Mac_Types;
with Mac_Text;
with Memory;
with Osutils;
with Rational_Error;
with System;
with Talk_Utils;
with Text_Io;
use Text_Io;
with Unchecked_Conversion;
package body Ls_R is

    package Ls_F is

        procedure From_Remote_Directory_In (Name : Mac_Text.Text);  
        procedure Level_In (From_Level : Mac_Types.Longint);
        procedure End_Ls (A_Connection : in out Communications.Connection);

    end Ls_F;

    procedure Write_A_Line (A_Connection : in out Communications.Connection;
                            T : Mac_Text.Text) is
    begin
        Interchange.Put_Int (A_Connection, Talk_Utils.F_A_Line);
        Interchange.Put_Text (A_Connection, T);
    end Write_A_Line;

    package body Ls_F is  
        Err : Mac_Types.Oserr := Mac_Types.Noerr;
        Level : Mac_Types.Longint;  
        From_Directory : Mac_Types.Str255;

        function As_Varinteger is new Unchecked_Conversion
                                         (Source => System.Address,
                                          Target => Mac_Types.Varinteger);

        function As_Varlongint is new Unchecked_Conversion
                                         (Source => System.Address,
                                          Target => Mac_Types.Varlongint);


        procedure From_Remote_Directory_In (Name : Mac_Text.Text) is
        begin  
            Err := Mac_Types.Noerr;
            Level := 0;  
            From_Directory := Mac_Text.Value (Name);
        end From_Remote_Directory_In;

        procedure Level_In (From_Level : Mac_Types.Longint) is
        begin
            Level := From_Level;
        end Level_In;

        procedure Print_Directories
                     (A_Connection : in out Communications.Connection;
                      Name : Mac_Types.Str255;
                      Level : Mac_Types.Longint) is  
            use Mac_Types;

            type Dircinfopbptr is access Files.Dircinfopbrec;
            type Hfilecinfopbptr is access Files.Hfilecinfopbrec;

            function As_Stringptr is new Unchecked_Conversion
                                            (Source => System.Address,
                                             Target => Mac_Types.Stringptr);

            function As_Cinfopbptr is new Unchecked_Conversion
                                             (Source => System.Address,
                                              Target => Files.Cinfopbptr);

            function As_Hfilecinfopbptr is
               new Unchecked_Conversion (Source => System.Address,
                                         Target => Hfilecinfopbptr);

            function As_Dircinfopbptr is
               new Unchecked_Conversion (Source => System.Address,
                                         Target => Dircinfopbptr);
            Err : Mac_Types.Oserr;  
            S : Mac_Types.Str255 := Name;
            Pb : Files.Cinfopbrec;
            Filepb : Hfilecinfopbptr := As_Hfilecinfopbptr (Pb'Address);  
            Dirpb : Dircinfopbptr := As_Dircinfopbptr (Pb'Address);
            T : Mac_Text.Text (256);  
            Unaccessible : constant Mac_Text.String := " unaccessible";

            procedure Enumerate_Catalog (Dirid : Mac_Types.Longint;
                                         Current_Level : Mac_Types.Longint) is
                Folder_Bit : constant Byte_Integer := 2#00001000#;
                Index : Mac_Types.Integer;  
            begin
                if Current_Level >= Level then
                    return;
                end if;
                Index := 1;
                loop
                    Pb.Iofdirindex := Index;
                    Dirpb.Iodrdirid := Dirid;
                    Err := Files.Pbgetcatinfo
                              (As_Cinfopbptr (Pb'Address), False);
                    if Err = Mac_Types.Noerr then
                        if Bit_Ops."and"
                              (Byte_Integer (Pb.Ioflattrib), Folder_Bit) /=
                           0 then  
                            Mac_Text.Set_Empty (T);
                            for I in 1 .. Current_Level loop
                                Mac_Text.Append (' ', T);
                            end loop;
                            Mac_Text.Append (Mac_Text.String (S), T);
                            Write_A_Line (A_Connection, T);
                            Enumerate_Catalog (Dirpb.Iodrdirid,
                                               Current_Level + 1);
                        else
                            Mac_Text.Set_Empty (T);
                            for I in 1 .. Current_Level loop
                                Mac_Text.Append (' ', T);
                            end loop;
                            Mac_Text.Append (Mac_Text.String (S), T);
                            Write_A_Line (A_Connection, T);
                        end if;
                    end if;
                    Index := Index + 1;
                    exit when Err /= Mac_Types.Noerr;
                end loop;
            end Enumerate_Catalog;

        begin  
            Pb.Iocompletion := null;
            Pb.Ionameptr := As_Stringptr (S'Address);
            Pb.Iovrefnum := 0;
            Pb.Iofdirindex := 0;
            Dirpb.Iodrdirid := 0;
            Err := Files.Pbgetcatinfo (As_Cinfopbptr (Pb'Address), False);
            if Err = Mac_Types.Noerr then
                Enumerate_Catalog (Dirpb.Iodrdirid, 0);
            else
                Mac_Text.Set (T, Mac_Text.String (S));
                Mac_Text.Append (Tail => Unaccessible, To => T);
                Write_A_Line (A_Connection, T);
            end if;
        end Print_Directories;


        procedure End_Ls (A_Connection : in out Communications.Connection) is
        begin  
            Print_Directories (A_Connection, From_Directory, Level);
            Mac_Files.Set_Current_User_Home;
            if Err /= Mac_Types.Noerr then
                Rational_Error.Raise_Mac_Error (Err);
            end if;
        end End_Ls;

    end Ls_F;

    procedure Read (A_Connection : in out Communications.Connection) is
        I : Mac_Types.Longint;
        B : Boolean;
        T : Mac_Text.Text (256);  
    begin
        Put_Line ("ls_r:read begin");
        Interchange.Get_Int (A_Connection, I);
        if I /= Talk_Utils.F_From_Remote_Directory then
            Rational_Error.Raise_Error (Rational_Error.Internal_Error);
        end if;  
        Interchange.Get_Text (A_Connection, T);
        Ls_F.From_Remote_Directory_In (T);
        Put ("ls_r:directory '");
        for I in 1 .. Mac_Text.Length (T) loop
            Put (Character'Val (Mac_Types.Char'Pos (Mac_Text.Value (I, T))));
        end loop;
        Put_Line ("'");
        Interchange.Get_Int (A_Connection, I);
        if I /= Talk_Utils.F_Level then
            Rational_Error.Raise_Error (Rational_Error.Internal_Error);
        end if;
        Interchange.Get_Int (A_Connection, I);
        Ls_F.Level_In (I);
        Put ("ls_r:level: ");
        Put_Line (Mac_Types.Longint'Image (I));
        Interchange.Get_Int (A_Connection, I);
        if I /= Talk_Utils.F_Delimitor then
            Rational_Error.Raise_Error (Rational_Error.Internal_Error);
        end if;
        Interchange.Get_Int (A_Connection, I);
        if I /= Talk_Utils.R_Ls then
            Rational_Error.Raise_Error (Rational_Error.Internal_Error);
        end if;
        Put_Line ("ls_r:read end");
    end Read;

    procedure Write (A_Connection : in out Communications.Connection) is
    begin
        Put_Line ("ls_r:write begin");
        begin  
            Ls_F.End_Ls (A_Connection);
        exception
            when others =>
                Rational_Error.Report
                   (A_Connection, Talk_Utils.R_Ls, Rational_Error.Get);
        end;
        Interchange.Put_Int (A_Connection, Talk_Utils.F_Delimitor);
        Interchange.Put_Int (A_Connection, Talk_Utils.R_Ls);
        Put_Line ("ls_r:write end");
    end Write;

end Ls_R;