|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 53248 (0xd000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Print, seg_02840b
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
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;
Io.Close (Temp);
exception
when others =>
if This_Object_Subclass = Text then
This_Kind := Text_File;
else
This_Kind := Other_Kind;
end if;
Io.Close (Temp);
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.Locte ("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;
nblk1=33
nid=0
hdr6=66
[0x00] rec0=21 rec1=00 rec2=01 rec3=080
[0x01] rec0=1a rec1=00 rec2=02 rec3=00a
[0x02] rec0=00 rec1=00 rec2=33 rec3=008
[0x03] rec0=16 rec1=00 rec2=03 rec3=064
[0x04] rec0=02 rec1=00 rec2=32 rec3=018
[0x05] rec0=13 rec1=00 rec2=04 rec3=032
[0x06] rec0=00 rec1=00 rec2=31 rec3=012
[0x07] rec0=21 rec1=00 rec2=05 rec3=000
[0x08] rec0=02 rec1=00 rec2=30 rec3=00a
[0x09] rec0=1a rec1=00 rec2=06 rec3=016
[0x0a] rec0=1d rec1=00 rec2=07 rec3=02e
[0x0b] rec0=1f rec1=00 rec2=08 rec3=038
[0x0c] rec0=12 rec1=00 rec2=09 rec3=014
[0x0d] rec0=00 rec1=00 rec2=2f rec3=022
[0x0e] rec0=18 rec1=00 rec2=0a rec3=01c
[0x0f] rec0=17 rec1=00 rec2=0b rec3=054
[0x10] rec0=00 rec1=00 rec2=2e rec3=01a
[0x11] rec0=19 rec1=00 rec2=0c rec3=020
[0x12] rec0=01 rec1=00 rec2=2d rec3=01a
[0x13] rec0=13 rec1=00 rec2=0d rec3=03e
[0x14] rec0=1b rec1=00 rec2=0e rec3=020
[0x15] rec0=1c rec1=00 rec2=0f rec3=046
[0x16] rec0=18 rec1=00 rec2=10 rec3=022
[0x17] rec0=00 rec1=00 rec2=2c rec3=026
[0x18] rec0=17 rec1=00 rec2=11 rec3=00a
[0x19] rec0=19 rec1=00 rec2=12 rec3=03a
[0x1a] rec0=15 rec1=00 rec2=13 rec3=02e
[0x1b] rec0=00 rec1=00 rec2=2b rec3=006
[0x1c] rec0=18 rec1=00 rec2=14 rec3=03a
[0x1d] rec0=14 rec1=00 rec2=15 rec3=018
[0x1e] rec0=11 rec1=00 rec2=16 rec3=048
[0x1f] rec0=1f rec1=00 rec2=17 rec3=012
[0x20] rec0=00 rec1=00 rec2=2a rec3=004
[0x21] rec0=17 rec1=00 rec2=18 rec3=07a
[0x22] rec0=17 rec1=00 rec2=19 rec3=094
[0x23] rec0=12 rec1=00 rec2=1a rec3=042
[0x24] rec0=18 rec1=00 rec2=1b rec3=038
[0x25] rec0=1a rec1=00 rec2=1c rec3=062
[0x26] rec0=17 rec1=00 rec2=1d rec3=03c
[0x27] rec0=00 rec1=00 rec2=29 rec3=002
[0x28] rec0=13 rec1=00 rec2=1e rec3=088
[0x29] rec0=12 rec1=00 rec2=1f rec3=032
[0x2a] rec0=16 rec1=00 rec2=20 rec3=04e
[0x2b] rec0=19 rec1=00 rec2=21 rec3=010
[0x2c] rec0=1a rec1=00 rec2=22 rec3=00a
[0x2d] rec0=1e rec1=00 rec2=23 rec3=030
[0x2e] rec0=16 rec1=00 rec2=24 rec3=026
[0x2f] rec0=14 rec1=00 rec2=25 rec3=058
[0x30] rec0=15 rec1=00 rec2=26 rec3=014
[0x31] rec0=15 rec1=00 rec2=27 rec3=008
[0x32] rec0=15 rec1=00 rec2=28 rec3=000
tail 0x21722347083c171fd3f2f 0x42a00088462065003