code.delx.au - gnu-emacs/blob - etc/ps-prin0.ps

   1 % === BEGIN ps-print prologue 0
   2 % version: 6.0
   3
   4 % Copyright (C) 2000, 2001  Free Software Foundation, Inc.
   5 %
   6 % This file is part of GNU Emacs.
   7 %
   8 % GNU Emacs is free software; you can redistribute it and/or modify
   9 % it under the terms of the GNU General Public License as published by
  10 % the Free Software Foundation; either version 2, or (at your option)
  11 % any later version.
  12 %
  13 % GNU Emacs is distributed in the hope that it will be useful,
  14 % but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 % GNU General Public License for more details.
  17 %
  18 % You should have received a copy of the GNU General Public License
  19 % along with GNU Emacs; see the file COPYING.  If not, write to the
  20 % Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 % Boston, MA 02111-1307, USA.
  22
  23 %%BeginProcSet: ErrorHandler
  24 % Downloaded Error Break-page handler
  25 % Adapted from:
  26 %     PostScript Language Program Design,
  27 %     Adobe Systems Incorporated.
  28 %     Appendix A, pages 217-219
  29
  30 /ps$brkpage where{pop}
  31 {
  32  /ps$brkpage 64 dict def
  33  ps$brkpage begin
  34   /tx 0 def/ty 0 def/toy 0 def/tox 0 def
  35   /prnt{
  36    dup type/stringtype ne{=string cvs}if
  37    dup length 6 mul
  38    /tx exch def/ty 10 def
  39    currentpoint/toy exch def/tox exch def
  40    1 setgray newpath
  41    tox toy 2 sub moveto
  42    0 ty rlineto tx 0 rlineto
  43    0 ty neg rlineto
  44    closepath fill
  45    tox toy moveto 0 setgray show
  46   }bind def
  47   /nl{currentpoint exch pop lmargin exch moveto 0 -10 rmoveto}def
  48   /=={/cp 0 def typeprint nl}def
  49   /typeprint{dup type dup currentdict exch known{exec}{unknowntype}ifelse}readonly def
  50   /lmargin 72 def
  51   /rmargin 72 def
  52   /tprint{
  53    dup length cp add rmargin gt{nl/cp 0 def}if
  54    dup length cp add/cp exch def
  55    prnt
  56   }readonly def
  57   /cvsprint{=string cvs tprint( )tprint}readonly def
  58   /unknowntype{exch pop cvlit(??)tprint cvsprint}readonly def
  59   /integertype{cvsprint}readonly def
  60   /realtype{cvsprint}readonly def
  61   /booleantype{cvsprint}readonly def
  62   /operatortype{(//)tprint cvsprint}readonly def
  63   /marktype{pop(-mark-)tprint}readonly def
  64   /dicttype{pop(-dictionary-)tprint}readonly def
  65   /nulltype{pop(-null-)tprint}readonly def
  66   /filetype{pop(-filestream-)tprint}readonly def
  67   /savetype{pop(-savelevel-)tprint}readonly def
  68   /fonttype{pop(-fontid-)tprint}readonly def
  69   /nametype{dup xcheck not{(/)tprint}if cvsprint}readonly def
  70   /stringtype{
  71    dup rcheck
  72    {(\()tprint tprint(\))tprint}
  73    {pop(-string-)tprint}ifelse}readonly def
  74   /arraytype{
  75    dup rcheck
  76    {dup xcheck
  77     {({)tprint{typeprint}forall(})tprint}
  78     {([)tprint{typeprint}forall(])tprint}ifelse}
  79    {pop(-array-)tprint}ifelse}readonly def
  80   /packedarraytype{
  81    dup rcheck
  82    {dup xcheck
  83     {({)tprint{typeprint}forall(})tprint}
  84     {([)tprint{typeprint}forall(])tprint}ifelse}
  85    {pop(-packedarray-)tprint}ifelse}readonly def
  86   /courier/Courier findfont 10 scalefont def
  87   /OLDhandleerror errordict/handleerror get def
  88  end %ps$brkpage
  89
  90  /handleerror{
  91   systemdict begin $error begin ps$brkpage begin
  92   newerror
  93   {/newerror false store vmstatus pop pop 0 ne{grestoreall}if
  94    initgraphics
  95    ErrorMessage 1 and 0 ne{ % print on paper
  96     courier setfont lmargin 720 moveto
  97     (# ERROR: )prnt errorname prnt nl
  98     (# OFFENDING COMMAND: )prnt/command load prnt
  99     $error/ostack known
 100     {nl nl(# STACK:)prnt nl nl $error/ostack get aload length{==}repeat}if
 101     $error/errorinfo known
 102     {nl nl(# ERRORINFO:)prnt nl nl $error/errorinfo get aload length{==}repeat}if
 103     systemdict/showpage get exec}if
 104    ErrorMessage 2 and 0 ne{ % send back to printing system
 105     (\%\%[ Error: )print errorname =print
 106     (; OffendingCommand: )print/command load =print
 107     $error/errorinfo known
 108     {(; ErrorInfo:)print $error/errorinfo get aload length{( )=print =print}repeat}if
 109     ( ]\%\%)= flush
 110     (\%\%[ Rest of job is ignored ]\%\%)= flush}if
 111    /newerror true store}if
 112   end end end
 113   stop
 114  } % handleerror
 115  dup 0 systemdict put % replace name by actual dict object
 116  dup 4 ps$brkpage put % replace name by dict object
 117  bind readonly
 118
 119  errordict 3 1 roll put % put proc in errordict as /handleerror
 120 }ifelse
 121 %%EndProcSet
 122
 123
 124 % operators for language level 2 only
 125
 126 (<<)cvn where                   % << operator
 127 {pop/BMark(<<)cvn load def}
 128 {/BMark{mark}bind def}ifelse
 129 (>>)cvn where                   % >> operator
 130 {pop/EMark(>>)cvn load def}
 131 {/EMark{counttomark 2 idiv dup dict begin{def}repeat pop currentdict end}bind def}ifelse
 132 /setpagedevice where            % setpagedevice
 133 {pop}
 134 {/setpagedevice{pop}bind def}ifelse
 135 /packedarray where              % packedarray
 136 {pop}
 137 {/packedarray{array astore readonly}bind def}ifelse
 138
 139
 140 % device dependent operators
 141
 142 /DefOp{
 143  dup where{pop pop pop}
 144  {exch dup where{pop}{pop/pop}ifelse load def}ifelse}def
 145
 146 /duplexmode/setduplexmode DefOp
 147 /tumble/settumble DefOp
 148
 149 % === END ps-print prologue 0