Rewritten using define-minor-mode.
[emacs.git] / etc / ps-prin0.ps
bloba302eab39a5b4ffab423d430bd92112f1ff05663
1 % === BEGIN ps-print prologue 0
3 %%BeginProcSet: ErrorHandler
4 % Downloaded Error Break-page handler
5 % Adapted from:
6 %     PostScript Language Program Design,
7 %     Adobe Systems Incorporated.
8 %     Appendix A, pages 217-219
10 /ps$brkpage where{pop}
12  /ps$brkpage 64 dict def
13  ps$brkpage begin
14   /tx 0 def /ty 0 def /toy 0 def /tox 0 def
15   /prnt{
16    dup type /stringtype ne{=string cvs}if
17    dup length 6 mul
18    /tx exch def /ty 10 def
19    currentpoint /toy exch def /tox exch def
20    1 setgray newpath
21    tox toy 2 sub moveto
22    0 ty rlineto tx 0 rlineto
23    0 ty neg rlineto
24    closepath fill
25    tox toy moveto 0 setgray show
26   }bind def
27   /nl{currentpoint exch pop lmargin exch moveto 0 -10 rmoveto}def
28   /=={/cp 0 def typeprint nl}def
29   /typeprint{dup type dup currentdict exch known{exec}{unknowntype}ifelse}readonly def
30   /lmargin 72 def
31   /rmargin 72 def
32   /tprint{
33    dup length cp add rmargin gt{nl /cp 0 def}if
34    dup length cp add /cp exch def
35    prnt
36   }readonly def
37   /cvsprint{=string cvs tprint( )tprint}readonly def
38   /unknowntype{exch pop cvlit(??)tprint cvsprint}readonly def
39   /integertype{cvsprint}readonly def
40   /realtype{cvsprint}readonly def
41   /booleantype{cvsprint}readonly def
42   /operatortype{(//)tprint cvsprint}readonly def
43   /marktype{pop(-mark-)tprint}readonly def
44   /dicttype{pop(-dictionary-)tprint}readonly def
45   /nulltype{pop(-null-)tprint}readonly def
46   /filetype{pop(-filestream-)tprint}readonly def
47   /savetype{pop(-savelevel-)tprint}readonly def
48   /fonttype{pop(-fontid-)tprint}readonly def
49   /nametype{dup xcheck not{(/)tprint}if cvsprint}readonly def
50   /stringtype{
51    dup rcheck
52    {(\()tprint tprint(\))tprint}
53    {pop(-string-)tprint}ifelse}readonly def
54   /arraytype{
55    dup rcheck
56    {dup xcheck
57     {({)tprint{typeprint}forall(})tprint}
58     {([)tprint{typeprint}forall(])tprint}ifelse}
59    {pop(-array-)tprint}ifelse}readonly def
60   /packedarraytype{
61    dup rcheck
62    {dup xcheck
63     {({)tprint{typeprint}forall(})tprint}
64     {([)tprint{typeprint}forall(])tprint}ifelse}
65    {pop(-packedarray-)tprint}ifelse}readonly def
66   /courier /Courier findfont 10 scalefont def
67   /OLDhandleerror errordict /handleerror get def
68  end %ps$brkpage
70  /handleerror{
71   systemdict begin $error begin ps$brkpage begin
72   newerror
73   {/newerror false store vmstatus pop pop 0 ne{grestoreall}if
74    initgraphics
75    ErrorMessage 1 and 0 ne{ % print on paper
76     courier setfont lmargin 720 moveto
77     (# ERROR: )prnt errorname prnt nl
78     (# OFFENDING COMMAND: )prnt /command load prnt
79     $error /ostack known
80     {nl nl(# STACK:)prnt nl nl $error /ostack get aload length{==}repeat}if
81     $error /errorinfo known
82     {nl nl(# ERRORINFO:)prnt nl nl $error /errorinfo get aload length{==}repeat}if
83     systemdict /showpage get exec}if
84    ErrorMessage 2 and 0 ne{ % send back to printing system
85     (\%\%[ Error: )print errorname =print
86     (; OffendingCommand: )print/command load =print
87     $error /errorinfo known
88     {(; ErrorInfo:)print $error /errorinfo get aload length{( )=print =print}repeat}if
89     ( ]\%\%)= flush
90     (\%\%[ Rest of job is ignored ]\%\%)= flush}if
91    /newerror true store}if
92   end end end
93   stop
94  } % handleerror
95  dup 0 systemdict put % replace name by actual dict object
96  dup 4 ps$brkpage put % replace name by dict object
97  bind readonly
99  errordict 3 1 roll put % put proc in errordict as /handleerror
100 }ifelse
101 %%EndProcSet
104 % operators for language level 2 only
106 (<<)cvn where                   % << operator
107 {pop/BMark(<<)cvn load def}
108 {/BMark{mark}bind def}ifelse
109 (>>)cvn where                   % >> operator
110 {pop/EMark(>>)cvn load def}
111 {/EMark{counttomark 2 idiv dup dict begin{def}repeat pop currentdict end}bind def}ifelse
112 /setpagedevice where            % setpagedevice
113 {pop}
114 {/setpagedevice{pop}bind def}ifelse
115 /packedarray where              % packedarray
116 {pop}
117 {/packedarray{array astore readonly}bind def}ifelse
120 % device dependent operators
122 /DefOp{
123  dup where{pop pop pop}
124  {exch dup where{pop}{pop/pop}ifelse load def}ifelse}def
126 /duplexmode /setduplexmode DefOp
127 /tumble /settumble DefOp
129 % === END ps-print prologue 0