⟦900b8f333⟧

TextFile

with Bounded_String;
with Common;
with Debug_Tools;
with Default;
with Directory;
with Directory_Tools;
with Io;
with Io_Exceptions;
with Library;
with Log;
with Object_Editor;
with Parameter_Parser;
-- with Print_Mailbox;
with Profile;
with Queue;
with String_Utilities;
with Switch_Implementation;
with System_Utilities;
with Time_Utilities;

procedure Print  
             (Object_Or_Image                          : String := "<CURSOR>";

              From_First_Page                          : Positive := 1;
              To_Last_Page                             : Positive := 3000;

              Display_As_Twoup                         : Boolean := True;
              Display_Border                           : Boolean := True;
              Display_Filename                         : Boolean := True;
              Display_Date                             : Boolean := True;

              Ignore_Display_Parameters_For_Postscript : Boolean := True;
              Highlight_Reserved_Words_For_Ada         : Boolean := True;

              Other_Options                            : String := "";

              Number_Of_Copies                         : Positive := 1;
              Printer                                  : String := "<Default>";
              Effort_Only                              : Boolean := False) is

    package Bounded renames Bounded_String;
    package Object  renames Directory_Tools.Object;
    package Naming  renames Directory_Tools.Naming;
    package Times   renames Time_Utilities;
    package Strings renames String_Utilities;

    Objects_To_Print : Object.Iterator :=
       Naming.Resolution (Name         => Object_Or_Image,
                          Context      => Naming.Default_Context,
                          Objects_Only => True);


    Map_Filename : constant String := "!Machine.Queues.User_To_Printer_Map";

    Error_Termination : exception;


    -- Printable object types
    type Kind_Of_Object is (Ada_Unit, Text_File, Postscript_File,
                            Image_File, Other_Kind);


    -- These are the main printer options
    -- Original_Raw, Raw, Postscript, and Format are mutually exclusive.
    type Printer_Options is (Nil, Original_Raw, Postscript, Format,
                             Raw, Banner_Page_User_Text, Length,
                             Notify, Spool_Each_Item, Class, Copies);
    package Option_Parser is
       new Parameter_Parser
              (Option_Id    => Printer_Options,
               Option_Kinds =>
                  "Original_Raw | Raw | Spool_Each_Item => Boolean," &
                     " others => Unspecified");


    -- Format options for laser printers
    Print_Two_Up_Format : Boolean := Display_As_Twoup;
    Print_Page_Border   : Boolean := Display_Border;
    Print_Filename      : Boolean := Display_Filename;
    Print_Date          : Boolean := Display_Date;

    In_Reversed_Order : Boolean := False;


    -- Global variables which determine the printer class, options, and format
    To_Printer_Class   : Bounded.Variable_String (200);
    To_Printer_Options : Bounded.Variable_String (200);
    Print_Laser        : Boolean;


    -- Temporary file for printing images
    The_Time : Times.Time := Times.Get_Time;
    Date_Image : constant String := Times.Image (Date       => The_Time,
                                                 Date_Style => Times.Ada,
                                                 Time_Style => Times.Ada,
                                                 Contents   => Times.Date_Only);  
    Time_Image : constant String := Times.Image (Date       => The_Time,
                                                 Date_Style => Times.Ada,
                                                 Time_Style => Times.Ada,
                                                 Contents   => Times.Time_Only);  
    Temp_Filename : constant String :=  
       "!Machine.Temporary." &  
          System_Utilities.User_Name & "_" & System_Utilities.Session_Name &  
          "_File_To_Print_On_" & Date_Image & "_At_" & Time_Image;




    function Eq (A, B : String; Ignore_Case : Boolean := True) return Boolean
        renames Strings.Equal;

    function Get_Printer_Class return String is
    begin
        if Bounded.Length (To_Printer_Class) /= 0 then
            return ", Class => " & Bounded.Image (To_Printer_Class);
        else
            return "";
        end if;
    end Get_Printer_Class;

    function Squeeze (S : String) return String is
        Result : String (1 .. S'Length);
        Index  : Natural := 1;
    begin
        for I in S'First .. S'Last loop
            if S (I) /= ' ' then
                Result (Index) := S (I);
                Index          := Index + 1;
            end if;
        end loop;
        return Result (1 .. Index - 1);
    end Squeeze;



    -- Retrieve printer type based on user and Printer parameter.
    procedure Get_Queue_Class is
        F : Io.File_Type;

        Next : Integer;


        function Match (Pattern, Name : String) return Boolean is
        begin
            if Name'Length /= 0 and then Name (Name'First) = '*' then
                return Eq (Pattern, Name);
            elsif Eq (Pattern, "others") then
                return True;
            elsif Pattern = "@" then
                return True;
            else
                return Eq (Pattern, Name);
            end if;
        end Match;


        function Get_User_Printer (Printer : String) return String is
            -- given the global printer parameter which is either <default> or
            -- a printer name, return the string to search for in the user
            -- to printer map file.  If <default> this is the user name,
            -- else it is the value of the parameter prefixed with an "*".
        begin
            if Eq (Printer, "<Default>") then
                return System_Utilities.User_Name;
            else
                return "*" & Printer;
            end if;
        end Get_User_Printer;


        function Token (S : String) return String is
            Start, Stop : Natural;
        begin
            if Next = -1 then
                Next := S'First; -- tricky initialization
            end if;
            Start := Next;
            -- skip leading blanks
            while Start <= S'Last and then S (Start) = ' ' loop
                Start := Start + 1;
            end loop;
            Next := Start;
            while Next <= S'Last and then S (Next) /= ' ' loop
                Next := Next + 1;
            end loop;
            if Start <= S'Last then
                if Next > S'Last then
                    Stop := S'Last;
                else -- S (Next) = ' '
                    Stop := Next - 1;
                end if;
                return S (Start .. Stop);
            else
                return "";
            end if;
        end Token;

        function Rest_Of_Line (S : String) return String is
            Stop : Natural;
        begin
            Stop := Strings.Locate (Fragment => "--",
                                    Within   => S (Next .. S'Last));
            if Stop = 0 then
                Stop := S'Last;
            else
                Stop := Stop - 1;
            end if;
            return Strings.Strip (S (Next .. Stop));
        end Rest_Of_Line;

    begin
        -- Check if it is an explicit printer name
        if Strings.Locate ("!!", Printer, True) /= 0 then
            Bounded.Copy (To_Printer_Class, Printer);
            return;
        end if;

        -- Find printer information in the user printer map
        declare
            User : constant String := Get_User_Printer (Printer);
        begin
            Io.Open (F, Io.In_File, Map_Filename);
            while not Io.End_Of_File (F) loop
                Next := -1;
                declare
                    Line          : constant String := Io.Get_Line (F);
                    User_Name     : constant String := Token (Line);
                    Class_Name    : constant String := Token (Line);
                    Printer_Type  : constant String := Token (Line);
                    Class_Options : constant String := Rest_Of_Line (Line);
                begin
                    if User_Name'Length < 2 or else
                       User_Name (User_Name'First .. User_Name'First + 1) /=
                          "--" then
                        if Match (User_Name, User) then
                            Io.Close (F);
                            Bounded.Copy (To_Printer_Class, Class_Name);
                            Bounded.Copy (To_Printer_Options, Class_Options);
                            if Printer_Type = "Laser" then
                                Print_Laser := True;
                            else
                                Print_Laser := False;
                            end if;
                            return;
                        end if;
                    end if;
                end;
            end loop;
            -- Didn't find a match!
            Io.Close (F);
            -- Report error
            if User (User'First) = '*' then
                Log.Put_Line
                   (Message  =>
                       "The printer " & User (User'First + 1 .. User'Last) &
                          " does not exist.  Please check the printer configuration" &
                          " file for possible names.",
                    Kind     => Profile.Error_Msg,
                    Response => Profile.Get);
            else
                Log.Put_Line
                   (Message  =>
                       "Could not print because no printer assignment has " &
                          "been made for you (" & User &
                          ").  Contact your system manager.  You can also " &
                          "specify an explicit printer name if you know one.",
                    Kind     => Profile.Error_Msg,
                    Response => Profile.Get);
            end if;
            raise Error_Termination;
        end;
    exception
        when Io_Exceptions.Name_Error =>
            -- map file does not exist!
            Bounded.Set_Length (To_Printer_Class, 0); -- try to use sys default
    end Get_Queue_Class;



    -- Returns the object type of This_Object_Name.
    -- This is also passed wildcard expressions, and therefore only returns
    -- the type of the first object in the list.
    function Get_Object_Kind
                (The_Object_List : in Object.Iterator) return Kind_Of_Object is

        Ada        : Object.Class_Enumeration renames Object.Ada_Class;
        File       : Object.Class_Enumeration renames Object.File_Class;
        Text       : Object.Subclass := Object.Value ("TEXT");
        Postscript : Object.Subclass := Object.Value ("POSTSCRIPT");

        The_Objects          : Object.Iterator := The_Object_List;
        This_Object          : Object.Handle;
        This_Object_Class    : Object.Class_Enumeration;
        This_Object_Subclass : Object.Subclass;

        Temp       : Io.File_Type;
        First_Char : Character;

        This_Kind : Kind_Of_Object;
        Last_Kind : Kind_Of_Object := Other_Kind;

        function "=" (Left, Right : in Object.Class_Enumeration) return Boolean
            renames Object."=";
        function "=" (Left, Right : in Object.Subclass)          return Boolean
            renames Object."=";

    begin
        Object.Reset (The_Objects);
        loop
            This_Object          := Object.Value (The_Objects);
            This_Object_Class    := Object.Class (The_Object => This_Object);
            This_Object_Subclass := Object.Subclass_Of
                                       (The_Object => This_Object);
            if This_Object_Class = Ada then
                This_Kind := Ada_Unit;
            elsif This_Object_Class = File then
                This_Object_Subclass := Object.Subclass_Of
                                           (The_Object => This_Object);
                if This_Object_Subclass = Postscript then
                    This_Kind := Postscript_File;
                else
                    begin
                        Io.Open (Temp, Io.In_File,
                                 Naming.Full_Name (This_Object));
                        Io.Get (Temp, First_Char);
                        if (First_Char = '%') then
                            This_Kind := Postscript_File;
                        elsif This_Object_Subclass = Text then
                            This_Kind := Text_File;
                        else
                            This_Kind := Other_Kind;
                        end if;
                    exception
                        when others =>
                            if This_Object_Subclass = Text then
                                This_Kind := Text_File;
                            else
                                This_Kind := Other_Kind;
                            end if;
                    end;
                end if;
            else
                This_Kind := Other_Kind;
            end if;
            if This_Kind /= Last_Kind then
                if Last_Kind = Other_Kind then
                    Last_Kind := This_Kind;
                else
                    This_Kind := Other_Kind;
                end if;
            end if;
            Object.Next (The_Objects);
            exit when Object.Done (The_Objects) or else This_Kind = Other_Kind;
        end loop;
        return This_Kind;
    exception
        when others =>
            return Other_Kind;
    end Get_Object_Kind;



    -- Write an image to a temporary file
    procedure Write_File (To_Filename : in String  := Temp_Filename;
                          Retries     : in Natural := 4) is

        File : Io.File_Type;
    begin
        Io.Create (File => File,
                   Mode => Io.Out_File,
                   Name => To_Filename,
                   Form => "");
        Io.Close (File => File);
        Common.Write_File (Name => To_Filename);
    exception
        when Io.Use_Error =>
            if Retries = 0 then
                Io.Echo
                   ("PRINT: Unable to print a window image " &
                    "(after retries, a USE_ERROR was encountered creating " &
                    Strings.Upper_Case (To_Filename) & ")");
                raise Error_Termination;
            else
                delay 1.0; -- wait for library to get "unbusy"
                Write_File (To_Filename => To_Filename,
                            Retries     => Retries - 1); -- recursive!
            end if;
    end Write_File;



    -- For printing mail messages.
    function Spooled_As_Mail (This_Image : in String) return Boolean is

        An_Object         : Directory.Object;
        Mailbox_Window_Id : constant String := "Mailboxes: ";
        Status            : Directory.Naming.Name_Status;

        procedure Copy_Mail_Messages (From_Mailbox_Image        : in String;
                                      To_Text_File              : in String;
                                      With_One_Message_Per_Page : in Boolean) is

            function Is_Main (Name : String) return Boolean is
            begin
                return Strings.Equal (Str1        => Name,
                                      Str2        => Strings.Upper_Case (Name),
                                      Ignore_Case => False);
            end Is_Main;
            function Find_Mailbox_Name (Image : String) return String is

                Next_Blank : constant Natural := Strings.Locate (" ", Image);
                Next_Lf : constant Natural := Strings.Locate (Ascii.Lf, Image);
            begin
                if (Image = "") or else (Next_Lf = Image'First) then
                    --
                    -- it's an empty image or there is no mailbox
                    --
                    raise Program_Error;
                elsif (Next_Blank > Next_Lf or else Next_Blank = 0) and then
                      Next_Lf /= 0 then

                    -- it's multiple lines with the first line containing no blanks
                    --
                    if Is_Main (Image (Image'First .. Next_Lf - 1)) then
                        return Image (Image'First .. Next_Lf - 1);
                    else
                        raise Program_Error;
                    end if;

                elsif Next_Blank /= 0 then
                    --
                    -- there is something else on the line beyond the next name
                    --
                    if Is_Main (Image (Image'First .. Next_Blank - 1)) then
                        return Image (Image'First .. Next_Blank - 1);
                    else
                        return Find_Mailbox_Name
                                  (Image (Next_Blank + 1 .. Image'Last));
                    end if;
                else
                    -- it's a single line with no blanks
                    --
                    if Is_Main (Image) then
                        return Image;

                    else
                        raise Program_Error;
                    end if;
                end if;

            end Find_Mailbox_Name;

            function Mailbox_Name (Image : String) return String is

                Next_Blank : constant Natural :=
                   Strings.Locate (Fragment    => " ",  
                                   Within      => Image,
                                   Ignore_Case => True);
                Next_Lf    : constant Natural :=
                   Strings.Locate (Fragment    => Ascii.Lf,
                                   Within      => Image,
                                   Ignore_Case => True);
            begin
                if (Image = "") or else (Next_Lf = Image'First) then
                    --
                    -- either an empty image or no mailbox
                    --
                    return "";
                elsif (Next_Blank = 0) and then (Next_Lf /= 0) then
                    --
                    -- multiple lines with the first line containing no blanks
                    --
                    if Is_Main (Image (Image'First .. Next_Lf - 1)) then
                        return Image (Image'First .. Next_Lf - 1);
                    else
                        return "";
                    end if;
                elsif Next_Blank /= 0 then
                    --
                    -- something else on the line beyond the next name
                    --
                    if Is_Main (Image (Image'First .. Next_Blank - 1)) then
                        return Image (Image'First .. Next_Blank - 1);
                    else
                        return Find_Mailbox_Name
                                  (Image (Next_Blank + 1 .. Image'Last));
                    end if;
                else
                    -- a single line with no blanks
                    --
                    if Is_Main (Image) then
                        return Image;
                    end if;
                end if;

                return "";
            end Mailbox_Name;
        begin
            Log.Put_Line ("Printing of mailboxes is not presently implemented.",
                          Profile.Error_Msg);
            -- Print_Mailbox (To_File => To_Text_File,
            --                One_Message_Per_Page => True,
            --                Mailbox_Name =>
            --                   Find_Mailbox_Name
            --                      (Image => From_Mailbox_Image
            --                                   (From_Mailbox_Image'First +
            --                                    Mailbox_Window_Id'Length ..
            --                                       From_Mailbox_Image'Last)));
            --
        end Copy_Mail_Messages;
    begin
        Object_Editor.Get_Object (Object    => An_Object,
                                  Status    => Status,
                                  Class     => Directory.Nil,
                                  Precision => Object_Editor.Image,
                                  Job       => Default.Process);

        if Directory.Naming."/=" (Status, Directory.Naming.Successful) then

            if Strings.Upper_Case (Object_Editor.Name) = "MAIL" then
                declare
                    Image_String : constant String :=
                       Object_Editor.Get_Text
                          (Precision => Object_Editor.Image);

                begin
                    if Image_String'Length > Mailbox_Window_Id'Length and then
                       Strings.Equal
                          (Str1        => Mailbox_Window_Id,
                           Str2        =>  
                              Image_String (Image_String'First ..
                                               (Image_String'First +
                                                Mailbox_Window_Id'Length - 1)),
                           Ignore_Case => True)  
                        then -- it's a mailbox image
                        Copy_Mail_Messages (From_Mailbox_Image => Image_String,
                                            To_Text_File => Temp_Filename,
                                            With_One_Message_Per_Page => True);
                        return True;
                    end if;
                end;
            end if;
        end if;

        return False;

    end Spooled_As_Mail;



    -- Setup printer options and make call to queue.print
    procedure Queue_To_Print (The_Object_Name : in String;
                              The_Object_Iter : in Object.Iterator) is

        -- Get the object type of the first element
        Object_Kind   : Kind_Of_Object := Get_Object_Kind (The_Object_Iter);
        Option_String : Bounded.Variable_String (300);

        -- Used to set the printer format
        Iter : Option_Parser.Iterator := Option_Parser.Parse (Other_Options);
        Format_Kind : Printer_Options := Nil;

        procedure Add_Option (Image : String) is
        begin
            if Bounded.Length (Option_String) = 0 then
                Bounded.Copy (Option_String, Image);
            else
                Bounded.Append (Option_String, ", " & Image);
            end if;
        end Add_Option;

    begin
        Bounded_String.Set_Length (Option_String, 0);

        -- Only check these options when Other_Options is set
        if Other_Options'Length /= 0 then
            -- Check that Other_Options is correct
            if not Option_Parser.Is_Successful (Iter) then
                Log.Put_Line
                   (Message  =>
                       "The Other_Options parameter could not be parsed" &
                          " because " & Option_Parser.Diagnosis (Iter),
                    Kind     => Profile.Error_Msg,
                    Response => Profile.Get);
                raise Error_Termination;
            end if;

            -- Add the basic printer options
            declare
                procedure Add_Main_Options (Option : Printer_Options) is
                    Image : constant String :=
                       Printer_Options'Image (Option) & " => " &
                          Option_Parser.Get_Image (Iter, Option);
                begin
                    if Option_Parser.Is_Ok (Iter, Option) then
                        Add_Option (Image);
                    end if;
                end Add_Main_Options;

            begin
                Add_Main_Options (Banner_Page_User_Text);
                Add_Main_Options (Length);
                Add_Main_Options (Notify);
                Add_Main_Options (Spool_Each_Item);
            end;

            -- Check the mutually exclusive printer formats
            declare
                procedure Check_Option (Kind : Printer_Options) is
                begin
                    if Option_Parser.Is_Ok (Iter, Kind) then
                        if Format_Kind /= Nil then
                            Log.Put_Line
                               (Message  =>
                                   "The Other_Options parameter contains conflicting formats: " &
                                      Printer_Options'Image (Format_Kind) &
                                      " & " & Printer_Options'Image (Kind),
                                Kind     => Profile.Error_Msg,
                                Response => Profile.Get);
                            raise Error_Termination;
                        else
                            case Kind is
                                when Original_Raw | Raw =>
                                    if Option_Parser.Get_Boolean
                                          (Iter, Kind) then
                                        Format_Kind := Kind;
                                    else
                                        Add_Option
                                           ("~" & Printer_Options'Image (Kind));
                                    end if;
                                when Postscript | Format =>
                                    Format_Kind := Kind;
                                when others =>
                                    null;
                            end case;
                        end if;
                    end if;
                end Check_Option;
            begin
                Check_Option (Original_Raw);
                Check_Option (Raw);
                Check_Option (Postscript);
                Check_Option (Format);
            end;


            case Format_Kind is
                when Original_Raw | Raw =>
                    Add_Option (Printer_Options'Image (Format_Kind));
                when Postscript =>
                    if not Print_Laser then
                        Log.Put_Line
                           (Message  =>
                               "You cannot use Postscript options " &
                                  "in the Other_Options parameter because the currently " &
                                  "selected printer is not a laser printer.",
                            Kind     => Profile.Error_Msg,
                            Response => Profile.Get);
                        raise Error_Termination;
                    end if;  
                when Format =>
                    Add_Option
                       ("Format => (" &
                        Option_Parser.Get_Image (Iter, Format_Kind) & ")");
                when others =>
                    null;
            end case;

        end if;



        -- Only set the following if format is nil or postscript and
        -- printer is a laser printer
        if (Format_Kind = Postscript) or
           (Format_Kind = Nil and Print_Laser) then

            -- Assemble the Options parameter using the following format:
            --
            -- POSTSCRIPT => ( FORMAT => [Autom{atic} | Fancy | Plain],
            --                 TWOUP => [True | False],
            --                 BORDER => [True | False],
            --                 FILENAME => [True | False],
            --                 DATE => [True | False],
            --                 PAGES => [1..Integer'Last]..[1..Integer'Last],
            --                 REVERSED => [True | False] ),
            --
            -- COPIES => [1..Natural'Last],
            -- CLASS => [Laser | !!Machine_Name.Laser | ...]
            --
            --

            declare
                Options_Image : constant String :=
                   Option_Parser.Get_Image (Iter, Postscript);
                Search_Image  : constant String := Squeeze (Options_Image);
            begin
                -- add the options passed in Other_Options first
                if Format_Kind = Postscript then
                    Add_Option ("Postscript => (" & Options_Image);
                else
                    Add_Option ("Postscript => (");
                end if;

                -- always set format, don't use format variable
                -- If format is set in Other_Options then ignore options
                if Strings.Locate ("Format=", Search_Image, True) = 0 then
                    -- Set Format
                    if Format_Kind = Postscript then
                        Bounded.Append (Option_String, ", ");
                    end if;
                    Bounded.Append (Option_String, "Format => ");
                    if (Object_Kind = Postscript_File) then
                        Bounded.Append (Option_String, "PostScript");
                    elsif (Object_Kind = Ada_Unit) and then
                          Highlight_Reserved_Words_For_Ada then
                        Bounded.Append (Option_String, "Fancy");
                    elsif (Object_Kind = Text_File) or
                          (Object_Kind = Ada_Unit) then
                        Bounded.Append (Option_String, "Plain_Text");
                    else
                        Bounded.Append (Option_String, "Automatic");
                    end if;


                    -- Add the options passed in the Printer config file
                    if Bounded.Length (To_Printer_Options) /= 0 then
                        Add_Option (Bounded.Image (To_Printer_Options));
                    end if;

                    -- Add the rest of the options
                    if Object_Kind /= Postscript_File or else
                       not Ignore_Display_Parameters_For_Postscript then
                        if Strings.Locate ("Twoup", Search_Image, True) = 0 then
                            Add_Option ("Twoup => " &
                                        Boolean'Image (Print_Two_Up_Format));
                        end if;
                        if Strings.Locate ("Border", Search_Image, True) =
                           0 then
                            Add_Option ("Border => " &
                                        Boolean'Image (Print_Page_Border));
                        end if;
                        if Strings.Locate ("Filename", Search_Image, True) =
                           0 then
                            Add_Option ("Filename => " &
                                        Boolean'Image (Print_Filename));
                        end if;
                        if Strings.Locate ("Date", Search_Image, True) = 0 then
                            Add_Option ("Date => " &
                                        Boolean'Image (Print_Date));
                        end if;
                    end if;

                    if Strings.Locate ("Pages=", Search_Image) = 0 then
                        Add_Option ("Pages =>" &
                                    Positive'Image (From_First_Page) & ".." &
                                    Positive'Image (To_Last_Page));
                    end if;
                end if;

                -- Finish postscript options
                Bounded.Append (Option_String, ")");

            end;
        elsif (Format_Kind = Nil) and then not Print_Laser then
            -- No options are specified to a line printer then use the
            -- System default
            if Switch_Implementation.Is_Defined ("Queue.Options") then
                Add_Option (Switch_Implementation.Value
                               (Switches => Switch_Implementation.Default_File,
                                Name     => "Queue.Options"));
            else
                Add_Option ("Format => (System_Header, Wrap)");
            end if;
        end if;


        -- Set the following for all objects and all printers

        -- Set the number of copies
        if Option_Parser.Is_Ok (Iter, Copies) then
            Add_Option ("Copies => " & Option_Parser.Get_Image (Iter, Copies));
        else
            Add_Option ("Copies =>" & Positive'Image (Number_Of_Copies));
        end if;

        -- Set the printer class
        if Option_Parser.Is_Ok (Iter, Class) then
            Add_Option ("Class => " & Option_Parser.Get_Image (Iter, Class));
        else
            Bounded.Append (Option_String, Get_Printer_Class);
        end if;


        -- Print the object or display the call
        if Effort_Only then
            Io.Echo ("Queue.Print (Name => """ &
                     The_Object_Name & """, Options => """ &
                     Bounded_String.Image (Option_String) & """);");
        else
            Queue.Print (Name    => The_Object_Name,
                         Options => Bounded_String.Image (Option_String),
                         Banner  => "<DEFAULT>",
                         Header  => "<DEFAULT>",
                         Footer  => "<DEFAULT>");
        end if;
    end Queue_To_Print;

begin
    -- determine if the object was resolvable
    --
    declare
        Error_Category : Object.Category_Enumeration :=
           Object.Category (Error_Code =>
                               Object.Err_Code (The_Objects =>
                                                   Objects_To_Print));
    begin
        case Error_Category is

            when Object.Successful |  
                 Object.Warning =>

                Get_Queue_Class;

                Queue_To_Print (Object_Or_Image, Objects_To_Print);

                return;

            when Object.Name_Error |  
                 Object.No_Object |  
                 Object.Selections_Not_Supported =>
                --
                -- seems to be a window image of some type
                --
                if not Spooled_As_Mail (This_Image => Object_Or_Image)  
                    then -- spool as window image file
                    Write_File (To_Filename => Temp_Filename, Retries => 4);
                end if;

                Get_Queue_Class;

                Objects_To_Print := Naming.Resolution (Temp_Filename);
                Queue_To_Print (Temp_Filename, Objects_To_Print);

                -- remove the temporary files
                --
                Library.Destroy (Existing  => Temp_Filename,
                                 Threshold => 1,
                                 Limit     => "<DIRECTORIES>",
                                 Response  => "");
                return;

            when Object.Cursor_Not_In_Selection |  
                 Object.No_Declaration |  
                 Object.No_Editor |  
                 Object.No_Selection |  
                 Object.Other_Error =>
                Object.Report (The_Objects => Objects_To_Print,
                               Response    => Profile.Get);
                Log.Put_Line
                   (Message  =>
                       "Could not print because no objects could be resolved" &
                          " (Status => " &
                          Object.Category_Enumeration'Image (Error_Category) &
                          ")",
                    Kind     => Profile.Error_Msg,
                    Response => Profile.Get);

            when Object.Ambiguous_Name |  
                 Object.Bad_Naming_Context |  
                 Object.Ill_Formed_Name |  
                 Object.Undefined_Name =>
                Object.Report (The_Objects => Objects_To_Print,
                               Response    => Profile.Get);
                Log.Put_Line
                   (Message  =>
                       "Could not print because one or more of the specified " &
                          "objects could not be resolved" & " (Status => " &
                          Object.Category_Enumeration'Image (Error_Category) &
                          ")",
                    Kind     => Profile.Error_Msg,
                    Response => Profile.Get);

            when Object.Lock_Error =>  
                Object.Report (The_Objects => Objects_To_Print,
                               Response    => Profile.Get);
                Log.Put_Line
                   (Message  =>
                       "Could not print because " &
                          "one or more of the specified objects are locked",
                    Kind     => Profile.Error_Msg,
                    Response => Profile.Get);

            when Object.Access_Error =>
                Object.Report (The_Objects => Objects_To_Print,
                               Response    => Profile.Get);
                Log.Put_Line
                   (Message  =>
                       "Could not print because this job does not have access " &
                          "to one or more of the specified objects",
                    Kind     => Profile.Error_Msg,
                    Response => Profile.Get);

            when Object.Version_Error =>  
                Object.Report (The_Objects => Objects_To_Print,
                               Response    => Profile.Get);
                Log.Put_Line
                   (Message  =>
                       "Could not print because the required version is not " &
                          "available for one or more of the specified objects",
                    Kind     => Profile.Error_Msg,
                    Response => Profile.Get);

            when Object.Policy_Error =>  
                Object.Report (The_Objects => Objects_To_Print,
                               Response    => Profile.Get);
                Log.Put_Line
                   (Message  =>
                       "Could not print because this operation violates " &
                          "a policy rule for one or more of the objects specified",
                    Kind     => Profile.Error_Msg,
                    Response => Profile.Get);

            when Object.Bad_Tree_Parameter |  
                 Object.Class_Error |  
                 Object.Code_Generation_Error |  
                 Object.Consistency_Error |  
                 Object.Illegal_Operation |  
                 Object.Obsolescence_Error |  
                 Object.Semantic_Error =>
                Object.Report (The_Objects => Objects_To_Print,
                               Response    => Profile.Get);
                Log.Put_Line
                   (Message  =>
                       "Could not print because an unexpected resolution " &
                          "error was encountered (Status => " &
                          Object.Category_Enumeration'Image (Error_Category) &
                          ")",
                    Kind     => Profile.Error_Msg,
                    Response => Profile.Get);
        end case;
    end;

exception
    when Error_Termination =>
        null;
    when others =>
        Log.Put_Line ("Unhandled exception: " & Debug_Tools.Get_Exception_Name,
                      Profile.Error_Msg);
end Print;
pragma Main;
DataMuseum.dk

Rational R1000/400 Tapes

⟦900b8f333⟧ TextFile

Derivation

TextFile
