plan9fox/sys/lib/ghostscript/errpage.ps
2011-03-30 19:35:09 +03:00

363 lines
8.4 KiB
PostScript

%!
% Copyright (C) 1992, 1996, 1998 Aladdin Enterprises. All rights reserved.
%
% This software is provided AS-IS with no warranty, either express or
% implied.
%
% This software is distributed under license and may not be copied,
% modified or distributed except as expressly authorized under the terms
% of the license contained in the file LICENSE in this distribution.
%
% For more information about licensing, please refer to
% http://www.ghostscript.com/licensing/. For information on
% commercial licensing, go to http://www.artifex.com/licensing/ or
% contact Artifex Software, Inc., 101 Lucas Valley Road #110,
% San Rafael, CA 94903, U.S.A., +1(415)492-9861.
% $Id: errpage.ps,v 1.4 2002/02/21 21:49:28 giles Exp $
% Print an informative error page if an error occurs.
% Inspired by Adobe's `ehandler.ps' and David Holzgang's PinPoint.
/EPdict 80 dict def
EPdict begin
/escale 12 def
/efont /Helvetica findfont escale scalefont def
/eheight escale 1.2 mul def
% Miscellaneous utilities
/xdef
{ exch def
} bind def
% Define `show' equivalents of = and ==
/show=
{ =string { cvs } stopped { pop pop (==unprintable==) } if show
} bind def
/.dict 18 dict def
.dict begin
/.buf =string def
/.cvp {.buf cvs show} bind def
/.nop {(-) .p type .cvp (-) .p} bind def
/.p {show} bind def
/.p1 {( ) dup 0 4 -1 roll put show} bind def
/.print
{dup type .dict exch known
{dup type exec} {.nop} ifelse
} bind def
/integertype /.cvp load def
/nulltype { pop (null) .p } bind def
/realtype /.cvp load def
/booleantype /.cvp load def
/nametype
{dup xcheck not {(/) .p} if
dup length .buf length gt
{dup length string}
{.buf}
ifelse cvs .p} bind def
/arraytype
{dup rcheck
{dup xcheck {(})({)} {(])([)} ifelse .p
exch () exch
{exch .p .print ( )} forall pop .p}
{.nop}
ifelse} bind def
/operatortype
{(--) .p .cvp (--) .p} bind def
/packedarraytype /arraytype load def
/stringtype
{dup rcheck
{(\() .p
{/.ch exch def
.ch 32 lt .ch 127 ge or
{(\\) .p .ch 8#1000 add 8 .buf cvrs 1 3 getinterval .p}
{.ch 40 eq .ch 41 eq or .ch 92 eq or
{(\\) .p} if
.ch .p1}
ifelse}
forall (\)) .p}
{.nop}
ifelse} bind def
end
/show==
{ .dict begin .print end
} bind def
% Printing utilities
/eol
{ /ey ey eheight sub def
ex ey moveto
} bind def
/setx
{ /ex xdef ex ey moveto
} bind def
/setxy
{ /ey xdef /ex xdef
ex ey moveto
} bind def
/indent
{ /lx ex def
( ) show currentpoint setxy
} bind def
/unindent
{ lx setx
} bind def
% Get the name of the n'th dictionary on the (saved) dictionary stack.
/nthdictname % n -> name true | false
{ dup dstack exch get
exch -1 0
{ dstack exch get
{ 2 index eq { exch pop exit } { pop } ifelse
}
forall
dup type /nametype eq { exit } if
}
for
dup type /nametype eq { true } { pop false } ifelse
} bind def
% Find the name of a currently executing procedure.
/findprocname % <proctail> findprocname <dstackindex> <procname> true
% <proctail> findprocname false
{ dup length /proclength xdef
dup type cvlit /proctype xdef
dstack length 1 sub -1 0
{ dup dstack exch get
{ dup type proctype eq
{ dup rcheck { dup length } { -1 } ifelse proclength gt
{ dup length proclength sub proclength getinterval 3 index eq
{ 3 -1 roll pop exit }
{ pop }
ifelse
}
{ pop pop
}
ifelse
}
{ pop pop
}
ifelse
}
forall
dup type /nametype eq { exit } if
pop
}
for
dup type /nametype eq { true } { pop false } ifelse
} bind def
% Error printing routine.
% The top 2 elements of the o-stack are systemdict and EPdict.
% For the moment, we ignore the possibility of stack overflow or VMerror.
/showerror % <command> <countexecstack> <errorname> showerror -
{
% Restore the error handlers.
saveerrordict { errordict 3 1 roll put } forall
$error /recordstacks false put
% Save information from the stacks.
/saveerror xdef
countexecstack array execstack
0 3 -1 roll 1 sub getinterval
/estack xdef
/savecommand xdef
countdictstack array dictstack
dup length 2 sub 0 exch getinterval
/dstack xdef
% Save state variables that will be reset.
% (We could save and print a lot more of the graphics state.)
/savefont currentfont def
mark { savefont /FontName get =string cvs cvn } stopped
{ cleartomark null }
{ exch pop dup length 0 eq { pop null } if }
ifelse /savefontname xdef
efont setfont
{ currentpoint } stopped { null null } if
/savey xdef /savex xdef
0 0
{ pop pop }
{ pop pop 1 add }
{ pop pop pop pop pop pop exch 1 add exch }
{ }
pathforall
/savelines xdef /savecurves xdef
/savepathbbox { [ pathbbox ] } stopped { pop null } if def
initmatrix
clippath pathbbox
/savecliptop xdef /saveclipright xdef
/saveclipbottom xdef /saveclipleft xdef
initclip
initgraphics
% Eject the current page.
showpage
% Print the page heading.
18 clippath pathbbox newpath
4 1 roll pop pop pop eheight sub 12 sub setxy
product (Product: )
statusdict /printername known
{ 100 string statusdict begin printername end
dup length 0 gt
{ exch pop exch pop (Printer name: ) }
{ pop }
ifelse
}
if show show eol
(Interpreter version ) show version show eol
(Error: ) show saveerror show= eol
(Command being executed: ) show /savecommand load show= eol
currentfile { fileposition } stopped
{ pop }
{ (Position in input file: ) show show= eol }
ifelse eol
% Print the current graphics state.
(Page parameters:) show eol indent
(page size: ) show
gsave clippath pathbbox grestore
exch 3 index sub show= (pt x ) show
exch sub show= (pt) show pop eol
(current position: ) show
savex null eq
{ (none) show }
{ (x = ) show savex show= (, y = ) show savey show= }
ifelse eol
savelines savecurves add 0 eq
{ (current path is empty) show
}
{ (current path: ) show savelines show= ( line(s), ) show
savecurves show= ( curve(s)) show eol
(path bounding box: ) show savepathbbox show==
}
ifelse eol
(current font: ) show
savefontname dup null eq
{ pop (--no name--) show }
{ show= ( ) show
gsave
savefontname findfont /FontMatrix get matrix invertmatrix
grestore
savefont /FontMatrix get matrix concatmatrix
dup 1 get 0 eq 1 index 2 get 0 eq and
1 index 4 get 0 eq and 1 index 5 get 0 eq and
1 index 0 get 2 index 3 get eq and
{ 0 get show= (pt) show }
{ (scaled by ) show show= }
ifelse
}
ifelse eol
eol unindent
% Print the operand stack.
/stky ey def
(Operand stack:) show eol indent
count { show== eol } repeat
eol unindent
% Print the dictionary stack.
(Dictionary stack:) show eol indent
dstack length 1 sub -1 0
{ nthdictname { show= } { (<unknown>) show } ifelse eol
} for
eol unindent
% Print the execution stack.
280 stky setxy
(Execution stack:) show eol indent
estack length 1 sub -1 1
{ estack exch get
dup type /operatortype eq
{ show= eol
}
{ dup type dup /arraytype eq exch /packedarraytype eq or
{ dup xcheck
{ dup rcheck
{ findprocname
{ show= nthdictname { ( in ) show show= } if eol
}
if
}
{ pop
}
ifelse
}
{ pop
}
ifelse
}
{ pop
}
ifelse
}
ifelse
} for eol unindent
% Print the next few lines of input.
% Unfortunately, this crashes on an Adobe printer.
(
(Next few lines of input:) show eol indent
/input currentfile def
mark { 4
{ input ( ) readstring not { pop exit } if
dup 0 get dup 10 eq
{ pop pop eol 1 sub dup 0 eq { pop exit } if }
{ dup 13 eq { pop pop } { pop show } ifelse }
ifelse
}
loop } stopped cleartomark eol unindent
) pop
% Wrap up.
showpage
quit
} def
% Define the common procedure for handling errors.
/doerror
{ systemdict begin EPdict begin showerror
} bind def
end
% Install our own error handlers.
/EPinstall
{ EPdict begin
/saveerrordict errordict length dict def
errordict saveerrordict copy pop
errordict
{ pop [ /countexecstack load 2 index cvlit /doerror load /exec load ] cvx
errordict 3 1 roll put
} forall
errordict /handleerror
[ /countexecstack load /handleerror /doerror load /exec load
] cvx
put
end
} bind def
EPinstall