% errorpage.ps - print a nice error page when a PS error occurs.

/myerrordict 30 dict def

myerrordict begin

/stringbuf 80 string def

/makestring { dup type /stringtype ne { stringbuf cvs } if } def

/printerrorsheet
{ save
  erasepage
  initgraphics
  (PostScript error)
  % string
  newpath clippath gsave stroke grestore flattenpath pathbbox newpath
  % string llx lly urx ury  (real values)
  36 sub 4 1 roll exch pop exch dup 36 add 3 1 roll sub 72 sub
  % string ury llx w
  /Times-Roman findfont dup 3 1 roll setfont
  % string ury llx font w
  dup 6 1 roll 4 index
  % w string ury llx font w string
  newpath 0 0 moveto true charpath flattenpath pathbbox newpath
  % w string ury llx font w sllx slly surx sury
  dup 8 1 roll
  % w string ury sury llx font w sllx slly surx sury
  3 -1 roll sub
  % w string ury sury llx font w sllx surx sh
  9 1 roll exch sub
  % w sh string ury sury llx font w sw
  div dup 5 1 roll scalefont setfont
  % w sh string ury scale sury llx
  2 index 8 1 roll
  % scale w sh string ury scale sury llx
  dup 7 1 roll 3 index 7 1 roll 4 1 roll mul sub
  % scale w llx ury sh string llx ury-(sury*scale)
  moveto show
  % scale w llx ury sh
  4 index mul 2 mul sub exch dup 3 -1 roll moveto
  % scale w llx
  3 -1 roll 2 div 3 1 roll
  % scale w llx  (scale now divided by 2)
  /Times-Roman findfont 3 index scalefont setfont
  % scale w llx
  (Error: ) show
  % scale w llx
  errorname makestring show
  % scale w llx
  dup currentpoint exch pop 4 index 1.2 mul sub moveto
  % scale w llx
  (Command: ) show
  % scale w llx
  /command load makestring show
  % scale w llx
  dup currentpoint exch pop 4 index sub moveto
  % scale w llx
  currentfont .5 scalefont setfont (Stacks:) show
  % scale w llx
  3 -1 roll pop
  % w llx
  currentpoint exch pop 25 sub
  % w llx cury
  dstack (Dictionary) 0 showastack
  ostack (Operand) 1 showastack
  estack (Execution) 2 showastack
  pop pop pop
  showpage
  restore
} def

/showastack
{ % w llx cury stack name column
  /Times-Roman findfont 10 scalefont setfont
  3 index 5 index 7 index 3 index mul 3 div add exch moveto
  % w llx cury stack name column
  1 index show
  % w llx cury stack name column
  6 copy pop pop exch 25 sub exch
  % w llx cury name column w llx y stack
  /Courier findfont 12 scalefont setfont
  % w llx cury name column w llx y stack
  mark 8 1 roll
  % w llx cury mark name column w llx y stack
  { 1 index 3 index 5 index 7 index mul 3 div add exch
    % w llx cury mark name column w llx y stack x y
    2 index length 1 sub -1 0
      { 3 index exch get newpath showstackitem } for
    % w llx cury mark name column w llx y stack x y
    moveto (--- Bottom ---) show
    % w llx cury mark name column w llx y stack
    pop
    % w llx cury mark name column w llx y
  } stopped
  % w llx cury mark name column w llx y ...possibly more... failed-p
  counttomark mark exch
  % w llx cury mark name column w llx y ... failed-p mark n
  1 sub 2 roll
  % w llx cury mark name column failed-p mark w llx y ...
  { type /marktype eq { exit } if } loop
  % w llx cury mark name column failed-p
  { 25 mul 100 exch sub 75 exch 3 -1 roll puterrinfoat } if
  { type /marktype eq { exit } if } loop
} def

/puterrinfoat
{ $error begin
  newerror
  { /newerror false def
    gsave
    moveto
    /Times-Roman findfont 10 scalefont setfont
    ([Error printing ) show show ( stack: ) show
    errorname makestring show
    (; offending command: ) show
    /command load makestring show
    (]) show
    grestore
  } if
  end
} def

/showstackitem
{ % x y item
  2 index 2 index moveto exch 15 sub exch
  dup type exec
} def

/arraytype
{ dup rcheck
  { dup xcheck {(}) ({)} {(]) ([)} ifelse show exch
    dup length 1 sub dup 4 gt { pop true exch 3 } { false 3 1 roll } ifelse
    0 exch 1 exch
    { dup 0 gt { ( ) show } if
      5 index 5 index 3 index 4 -1 roll
      get dup type exec
      pop pop
    } for
    pop
    { ( ...) show } if
    show
  }
  { xcheck {({...} unreadable)} {([...] unreadable)} ifelse show }
  ifelse
} def

/booleantype { {(true)} {(false)} ifelse show } def

/dicttype
{ countdictstack array dictstack
  false 1 index length 1 sub 0 exch 1 exch
  { 2 index exch get false exch
    dup rcheck
    { { 5 index eq { exch pop true exit } { pop } ifelse } forall
      { exch pop true exit } if
    }
    { pop pop }
    ifelse
  } for
  { stringbuf cvs } { (-can't find name-) } ifelse show
  pop pop
} def

/filetype { pop (-file-) show } def

/fonttype
{ false
  FontDirectory { 3 index eq { exch pop true exit } { pop } ifelse } forall
  { (-font:) show stringbuf cvs show (-) show } { (-unknown font-) show } ifelse
  pop
} def

/integertype { stringbuf cvs show } def

/marktype { pop (-mark-) show } def

/nametype { (/) show stringbuf cvs show } def

/nulltype { pop (-null-) show } def

/nametype { stringbuf cvs show } def

/operatortype { stringbuf cvs show } def

/packedarraytype % not in red book?!
{ dup rcheck
  { dup xcheck {(}}) ({{)} {(]]) ([[)} ifelse show exch
    dup length 1 sub dup 4 gt { pop true exch 3 } { false 3 1 roll } ifelse
    0 exch 1 exch
    { dup 0 gt { ( ) show } if
      5 index 5 index 3 index 4 -1 roll
      get dup type exec
      pop pop
    } for
    pop
    { ( ...) show } if
    show
  }
  { xcheck {({{...}} unreadable)} {([[...]] unreadable)} ifelse show }
  ifelse
} def

/realtype { stringbuf cvs show } def

/savetype { pop (-save-) show } def

/stringtype
{ dup rcheck
  { (\() show
    dup length 30 gt { 0 30 getinterval show (...) } if
    show (\)) show
  }
  { pop (-unreadable string-) show }
  ifelse
} def

/handleerror
{ $error begin
  newerror { /newerror false def printerrorsheet } if
  end
} def

end

errordict begin /handleerror { myerrordict begin handleerror end } def end
