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