1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-20 10:23:57 +00:00
emacs/etc/ps-prin0.ps
2011-01-26 00:36:39 -08:00

159 lines
5.2 KiB
PostScript

% === BEGIN ps-print prologue 0
% version: 6.0
% Copyright (C) 2000-2011 Free Software Foundation, Inc.
% This file is part of GNU Emacs.
% GNU Emacs is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
% GNU Emacs is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
% GNU General Public License for more details.
% You should have received a copy of the GNU General Public License
% along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
% As a special exception, the copyright holders of this module give
% you permission to include the module in a Postscript file generated
% by Emacs or other free software together with the result of
% converting text to be printed, regardless of the license terms of
% that text, and to use under terms of your choice the page images
% resulting from formatting said combination. If you modify this
% module, you may extend this exception to your version of the module
% but you are not obligated to do so. If you do not wish to do so,
% delete this exception statement from your version.
%%BeginProcSet: ErrorHandler
% Downloaded Error Break-page handler
% Adapted from:
% PostScript Language Program Design,
% Adobe Systems Incorporated.
% Appendix A, pages 217-219
/ps$brkpage where{pop}
{
/ps$brkpage 64 dict def
ps$brkpage begin
/tx 0 def/ty 0 def/toy 0 def/tox 0 def
/prnt{
dup type/stringtype ne{=string cvs}if
dup length 6 mul
/tx exch def/ty 10 def
currentpoint/toy exch def/tox exch def
1 setgray newpath
tox toy 2 sub moveto
0 ty rlineto tx 0 rlineto
0 ty neg rlineto
closepath fill
tox toy moveto 0 setgray show
}bind def
/nl{currentpoint exch pop lmargin exch moveto 0 -10 rmoveto}def
/=={/cp 0 def typeprint nl}def
/typeprint{dup type dup currentdict exch known{exec}{unknowntype}ifelse}readonly def
/lmargin 72 def
/rmargin 72 def
/tprint{
dup length cp add rmargin gt{nl/cp 0 def}if
dup length cp add/cp exch def
prnt
}readonly def
/cvsprint{=string cvs tprint( )tprint}readonly def
/unknowntype{exch pop cvlit(??)tprint cvsprint}readonly def
/integertype{cvsprint}readonly def
/realtype{cvsprint}readonly def
/booleantype{cvsprint}readonly def
/operatortype{(//)tprint cvsprint}readonly def
/marktype{pop(-mark-)tprint}readonly def
/dicttype{pop(-dictionary-)tprint}readonly def
/nulltype{pop(-null-)tprint}readonly def
/filetype{pop(-filestream-)tprint}readonly def
/savetype{pop(-savelevel-)tprint}readonly def
/fonttype{pop(-fontid-)tprint}readonly def
/nametype{dup xcheck not{(/)tprint}if cvsprint}readonly def
/stringtype{
dup rcheck
{(\()tprint tprint(\))tprint}
{pop(-string-)tprint}ifelse}readonly def
/arraytype{
dup rcheck
{dup xcheck
{({)tprint{typeprint}forall(})tprint}
{([)tprint{typeprint}forall(])tprint}ifelse}
{pop(-array-)tprint}ifelse}readonly def
/packedarraytype{
dup rcheck
{dup xcheck
{({)tprint{typeprint}forall(})tprint}
{([)tprint{typeprint}forall(])tprint}ifelse}
{pop(-packedarray-)tprint}ifelse}readonly def
/courier/Courier findfont 10 scalefont def
/OLDhandleerror errordict/handleerror get def
end %ps$brkpage
/handleerror{
systemdict begin $error begin ps$brkpage begin
newerror
{/newerror false store vmstatus pop pop 0 ne{grestoreall}if
initgraphics
ErrorMessage 1 and 0 ne{ % print on paper
courier setfont lmargin 720 moveto
(# ERROR: )prnt errorname prnt nl
(# OFFENDING COMMAND: )prnt/command load prnt
$error/ostack known
{nl nl(# STACK:)prnt nl nl $error/ostack get aload length{==}repeat}if
$error/errorinfo known
{nl nl(# ERRORINFO:)prnt nl nl $error/errorinfo get aload length{==}repeat}if
systemdict/showpage get exec}if
ErrorMessage 2 and 0 ne{ % send back to printing system
(\%\%[ Error: )print errorname =print
(; OffendingCommand: )print/command load =print
$error/errorinfo known
{(; ErrorInfo:)print $error/errorinfo get aload length{( )=print =print}repeat}if
( ]\%\%)= flush
(\%\%[ Rest of job is ignored ]\%\%)= flush}if
/newerror true store}if
end end end
stop
} % handleerror
dup 0 systemdict put % replace name by actual dict object
dup 4 ps$brkpage put % replace name by dict object
bind readonly
errordict 3 1 roll put % put proc in errordict as /handleerror
}ifelse
%%EndProcSet
% operators for language level 2 only
(<<)cvn where % << operator
{pop/BMark(<<)cvn load def}
{/BMark{mark}bind def}ifelse
(>>)cvn where % >> operator
{pop/EMark(>>)cvn load def}
{/EMark{counttomark 2 idiv dup dict begin{def}repeat pop currentdict end}bind def}ifelse
/setpagedevice where % setpagedevice
{pop}
{/setpagedevice{pop}bind def}ifelse
/packedarray where % packedarray
{pop}
{/packedarray{array astore readonly}bind def}ifelse
% device dependent operators
/DefOp{
dup where{pop pop pop}
{exch dup where{pop}{pop/pop}ifelse load def}ifelse}def
/duplexmode/setduplexmode DefOp
/tumble/settumble DefOp
% === END ps-print prologue 0