summaryrefslogtreecommitdiff
path: root/Master/xemtex/gslib/errpage.ps
blob: 7619205168cdbd187515caf856f46d5bde12d12c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
%!
%    Copyright (C) 1992, 1996, 1998 Aladdin Enterprises.  All rights reserved.
% 
% This program 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 2 of the License, or (at your
% option) any later version.
%
% This program 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 this program; if not, write to the Free Software Foundation, Inc.,
% 59 Temple Place, Suite 330, Boston, MA, 02111-1307.

% $Id: errpage.ps,v 1.2.6.1.2.1 2003/04/12 14:02:38 giles Exp $
% Print an informative error page if an error occurs.
% Inspired by Adobe's `ehandler.ps' and David Holzgang's PinPoint.

/EPdict 80 dict def
EPdict begin

/escale 12 def
/efont /Helvetica findfont escale scalefont def
/eheight escale 1.2 mul def

% Miscellaneous utilities
/xdef
 { exch def
 } bind def

% Define `show' equivalents of = and ==

/show=
 { =string { cvs } stopped { pop pop (==unprintable==) } if show
 } bind def

/.dict 18 dict def
.dict begin
  /.buf =string def
  /.cvp {.buf cvs show} bind def
  /.nop {(-) .p type .cvp (-) .p} bind def
  /.p {show} bind def
  /.p1 {( ) dup 0 4 -1 roll put show} bind def
  /.print
	{dup type .dict exch known
	 {dup type exec} {.nop} ifelse
	} bind def
  /integertype /.cvp load def
  /nulltype { pop (null) .p } bind def
  /realtype /.cvp load def
  /booleantype /.cvp load def
  /nametype
	{dup xcheck not {(/) .p} if
	 dup length .buf length gt
	  {dup length string}
	  {.buf}
	 ifelse cvs .p} bind def
  /arraytype
	{dup rcheck
	  {dup xcheck {(})({)} {(])([)} ifelse .p
	   exch () exch
	   {exch .p .print ( )} forall pop .p}
	  {.nop}
	 ifelse} bind def
  /operatortype
  	{(--) .p .cvp (--) .p} bind def
  /packedarraytype /arraytype load def
  /stringtype
	{dup rcheck
	  {(\() .p
	   {/.ch exch def
	    .ch 32 lt .ch 127 ge or
	    {(\\) .p .ch 8#1000 add 8 .buf cvrs 1 3 getinterval .p}
	    {.ch 40 eq .ch 41 eq or .ch 92 eq or
	     {(\\) .p} if
	     .ch .p1}
	    ifelse}
	   forall (\)) .p}
	  {.nop}
	 ifelse} bind def
end
/show==
 { .dict begin .print end
 } bind def

% Printing utilities

/eol
 { /ey ey eheight sub def
   ex ey moveto
 } bind def
/setx
 { /ex xdef ex ey moveto
 } bind def
/setxy
 { /ey xdef /ex xdef
   ex ey moveto
 } bind def
/indent
 { /lx ex def
   (    ) show currentpoint setxy
 } bind def
/unindent
 { lx setx
 } bind def

% Get the name of the n'th dictionary on the (saved) dictionary stack.
/nthdictname	% n -> name true | false
 { dup dstack exch get
   exch -1 0
    { dstack exch get
       { 2 index eq { exch pop exit } { pop } ifelse
       }
      forall
      dup type /nametype eq { exit } if
    }
   for
   dup type /nametype eq { true } { pop false } ifelse
 } bind def

% Find the name of a currently executing procedure.
/findprocname	% <proctail> findprocname <dstackindex> <procname> true
		% <proctail> findprocname false
 { dup length /proclength xdef
   dup type cvlit /proctype xdef
   dstack length 1 sub -1 0
    { dup dstack exch get
       { dup type proctype eq
          { dup rcheck { dup length } { -1 } ifelse proclength gt
	     { dup length proclength sub proclength getinterval 3 index eq
	        { 3 -1 roll pop exit }
		{ pop }
	       ifelse
	     }
	     { pop pop
	     }
	    ifelse
	  }
	  { pop pop
	  }
	 ifelse
       }
      forall
      dup type /nametype eq { exit } if
      pop
    }
   for
   dup type /nametype eq { true } { pop false } ifelse
 } bind def

% Error printing routine.
% The top 2 elements of the o-stack are systemdict and EPdict.
% For the moment, we ignore the possibility of stack overflow or VMerror.
/showerror	% <command> <countexecstack> <errorname> showerror -
 {
	% Restore the error handlers.

   saveerrordict { errordict 3 1 roll put } forall
   $error /recordstacks false put

	% Save information from the stacks.

   /saveerror xdef
   countexecstack array execstack
   0 3 -1 roll 1 sub getinterval
   /estack xdef
   /savecommand xdef

   countdictstack array dictstack
   dup length 2 sub 0 exch getinterval
   /dstack xdef

	% Save state variables that will be reset.
	% (We could save and print a lot more of the graphics state.)

   /savefont currentfont def
   mark { savefont /FontName get =string cvs cvn } stopped
    { cleartomark null }
    { exch pop dup length 0 eq { pop null } if }
   ifelse /savefontname xdef
   efont setfont

    { currentpoint } stopped { null null } if
   /savey xdef /savex xdef
   0 0
    { pop pop }
    { pop pop 1 add }
    { pop pop pop pop pop pop exch 1 add exch }
    { }
   pathforall
   /savelines xdef /savecurves xdef
   /savepathbbox { [ pathbbox ] } stopped { pop null } if def

   initmatrix

   clippath pathbbox
     /savecliptop xdef /saveclipright xdef
     /saveclipbottom xdef /saveclipleft xdef
   initclip

   initgraphics

	% Eject the current page.

   showpage

	% Print the page heading.

   18 clippath pathbbox newpath
   4 1 roll pop pop pop eheight sub 12 sub setxy
   product (Product: )
   statusdict /printername known
    { 100 string statusdict begin printername end
      dup length 0 gt
       { exch pop exch pop (Printer name: ) }
       { pop }
      ifelse
    }
   if show show eol
   (Interpreter version ) show version show eol
   (Error: ) show saveerror show= eol
   (Command being executed: ) show /savecommand load show= eol
   currentfile { fileposition } stopped
    { pop }
    { (Position in input file: ) show show= eol }
   ifelse eol

	% Print the current graphics state.

   (Page parameters:) show eol indent
   (page size: ) show
     gsave clippath pathbbox grestore
     exch 3 index sub show= (pt x ) show
     exch sub show= (pt) show pop eol
   (current position: ) show
   savex null eq
    { (none) show }
    { (x = ) show savex show= (, y = ) show savey show= }
   ifelse eol
   savelines savecurves add 0 eq
    { (current path is empty) show
    }
    { (current path: ) show savelines show= ( line(s), ) show
      savecurves show= ( curve(s)) show eol
      (path bounding box: ) show savepathbbox show==
    }
   ifelse eol
   (current font: ) show
     savefontname dup null eq
      { pop (--no name--) show }
      { show= ( ) show
        gsave
        savefontname findfont /FontMatrix get matrix invertmatrix
	grestore
        savefont /FontMatrix get matrix concatmatrix
	dup 1 get 0 eq 1 index 2 get 0 eq and
	1 index 4 get 0 eq and 1 index 5 get 0 eq and
	1 index 0 get 2 index 3 get eq and
	 { 0 get show= (pt) show }
	 { (scaled by ) show show= }
	ifelse
      }
     ifelse eol
   eol unindent

	% Print the operand stack.

   /stky ey def
   (Operand stack:) show eol indent
   count { show== eol } repeat
   eol unindent

	% Print the dictionary stack.

   (Dictionary stack:) show eol indent
   dstack length 1 sub -1 0
    { nthdictname { show= } { (<unknown>) show } ifelse eol
    } for
   eol unindent

	% Print the execution stack.

   280 stky setxy
   (Execution stack:) show eol indent
   estack length 1 sub -1 1
    { estack exch get
      dup type /operatortype eq
       { show= eol
       }
       { dup type dup /arraytype eq exch /packedarraytype eq or
          { dup xcheck
	     { dup rcheck
	        { findprocname
		   { show= nthdictname { ( in ) show show= } if eol
		   }
		  if
		}
		{ pop
		}
	       ifelse
	     }
	     { pop
	     }
	    ifelse
	  }
	  { pop
	  }
	 ifelse
       }
      ifelse
    } for eol unindent

	% Print the next few lines of input.
	% Unfortunately, this crashes on an Adobe printer.

(
   (Next few lines of input:) show eol indent
   /input currentfile def
   mark { 4
    { input ( ) readstring not { pop exit } if
      dup 0 get dup 10 eq
       { pop pop eol 1 sub dup 0 eq { pop exit } if }
       { dup 13 eq { pop pop } { pop show } ifelse }
      ifelse
    }
   loop } stopped cleartomark eol unindent
) pop

	% Wrap up.

   showpage
   quit

 } def

% Define the common procedure for handling errors.
/doerror
 { systemdict begin EPdict begin showerror
 } bind def

end

% Install our own error handlers.

/EPinstall
 { EPdict begin
   /saveerrordict errordict length dict def
   errordict saveerrordict copy pop
   errordict
    { pop [ /countexecstack load 2 index cvlit /doerror load /exec load ] cvx
      errordict 3 1 roll put
    } forall
   errordict /handleerror
     [ /countexecstack load /handleerror /doerror load /exec load
     ] cvx
   put
   end
 } bind def

EPinstall