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