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