%! % Copyright (C) 1992, 1996, 1998 Aladdin Enterprises. All rights reserved. % % This program is free software; you can redistribute it and/or modify it % under the terms of the GNU General Public License as published by the % Free Software Foundation; either version 2 of the License, or (at your % option) any later version. % % This program is distributed in the hope that it will be useful, but % WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General % Public License for more details. % % You should have received a copy of the GNU General Public License along % with this program; if not, write to the Free Software Foundation, Inc., % 59 Temple Place, Suite 330, Boston, MA, 02111-1307. % $Id: errpage.ps,v 1.2.6.1.2.1 2003/04/12 14:02:38 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 % findprocname true % 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 % 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= } { () 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