(REGEX_FREE_STACK, RESET_FAIL_STACK): Make them usable as an expression.
[emacs.git] / etc / ps-prin1.ps
blob903b08d3573ca48ab4bfaf4cc6af4365dda372a2
1 % === BEGIN ps-print prologue 1
3 % ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
4 /ISOLatin1Encoding where {pop}{
5 % -- The ISO Latin-1 encoding vector isn't known, so define it.
6 % -- The first half is the same as the standard encoding,
7 % -- except for minus instead of hyphen at code 055.
8 /ISOLatin1Encoding
9 StandardEncoding 0 45 getinterval aload pop
10     /minus
11 StandardEncoding 46 82 getinterval aload pop
12 %*** NOTE: the following are missing in the Adobe documentation,
13 %*** but appear in the displayed table:
14 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
15 % 0200 (128)
16     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
17     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
18     /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
19     /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
20 % 0240 (160)
21     /space /exclamdown /cent /sterling
22         /currency /yen /brokenbar /section
23     /dieresis /copyright /ordfeminine /guillemotleft
24         /logicalnot /hyphen /registered /macron
25     /degree /plusminus /twosuperior /threesuperior
26         /acute /mu /paragraph /periodcentered
27     /cedilla /onesuperior /ordmasculine /guillemotright
28         /onequarter /onehalf /threequarters /questiondown
29 % 0300 (192)
30     /Agrave /Aacute /Acircumflex /Atilde
31         /Adieresis /Aring /AE /Ccedilla
32     /Egrave /Eacute /Ecircumflex /Edieresis
33         /Igrave /Iacute /Icircumflex /Idieresis
34     /Eth /Ntilde /Ograve /Oacute
35         /Ocircumflex /Otilde /Odieresis /multiply
36     /Oslash /Ugrave /Uacute /Ucircumflex
37         /Udieresis /Yacute /Thorn /germandbls
38 % 0340 (224)
39     /agrave /aacute /acircumflex /atilde
40         /adieresis /aring /ae /ccedilla
41     /egrave /eacute /ecircumflex /edieresis
42         /igrave /iacute /icircumflex /idieresis
43     /eth /ntilde /ograve /oacute
44         /ocircumflex /otilde /odieresis /divide
45     /oslash /ugrave /uacute /ucircumflex
46         /udieresis /yacute /thorn /ydieresis
47 256 packedarray def
48 }ifelse
50 /reencodeFontISO{ %def
51   dup
52   length 12 add dict    % Make a new font (a new dict the same size
53                         % as the old one) with room for our new symbols.
55   begin                 % Make the new font the current dictionary.
58     {1 index /FID ne
59      {def}{pop pop}ifelse
60     }forall             % Copy each of the symbols from the old dictionary
61                         % to the new one except for the font ID.
63     currentdict /FontType get 0 ne{
64       /Encoding ISOLatin1Encoding def   % Override the encoding with
65                                         % the ISOLatin1 encoding.
66     }if
68     % Use the font's bounding box to determine the ascent, descent,
69     % and overall height; don't forget that these values have to be
70     % transformed using the font's matrix.
72 %          ^    (x2 y2)
73 %          |       |
74 %          |       v
75 %          |  +----+ - -
76 %          |  |    |   ^
77 %          |  |    |   | Ascent (usually > 0)
78 %          |  |    |   |
79 % (0 0) -> +--+----+-------->
80 %             |    |   |
81 %             |    |   v Descent (usually < 0)
82 % (x1 y1) --> +----+ - -
84     currentdict /FontType get 0 ne{
85       /FontBBox load aload pop                  % -- x1 y1 x2 y2
86       FontMatrix transform /Ascent  exch def pop
87       FontMatrix transform /Descent exch def pop
88     }{
89       /PrimaryFont FDepVector 0 get def
90       PrimaryFont /FontBBox get aload pop
91       PrimaryFont /FontMatrix get transform /Ascent exch def pop
92       PrimaryFont /FontMatrix get transform /Descent exch def pop
93     }ifelse
95     /FontHeight Ascent Descent sub def  % use `sub' because descent < 0
97     % Define these in case they're not in the FontInfo
98     % (also, here they're easier to get to).
99     /UnderlinePosition  Descent 0.70 mul def
100     /OverlinePosition   Descent UnderlinePosition sub Ascent add def
101     /StrikeoutPosition  Ascent 0.30 mul def
102     /LineThickness      FontHeight 0.05 mul def
103     /Xshadow            FontHeight  0.08 mul def
104     /Yshadow            FontHeight -0.09 mul def
105     /SpaceBackground    Descent neg UnderlinePosition add def
106     /XBox               Descent neg def
107     /YBox               LineThickness 0.7 mul def
109     currentdict         % Leave the new font on the stack
110     end                 % Stop using the font as the current dictionary.
111     definefont          % Put the font into the font dictionary
112     pop                 % Discard the returned font.
113 }bind def
115 /DefFont{                               % Font definition
116   findfont exch scalefont reencodeFontISO
117 }def
119 /F{                                     % Font selection
120   findfont
121   dup /Ascent            get /Ascent            exch def
122   dup /Descent           get /Descent           exch def
123   dup /FontHeight        get /FontHeight        exch def
124   dup /UnderlinePosition get /UnderlinePosition exch def
125   dup /OverlinePosition  get /OverlinePosition  exch def
126   dup /StrikeoutPosition get /StrikeoutPosition exch def
127   dup /LineThickness     get /LineThickness     exch def
128   dup /Xshadow           get /Xshadow           exch def
129   dup /Yshadow           get /Yshadow           exch def
130   dup /SpaceBackground   get /SpaceBackground   exch def
131   dup /XBox              get /XBox              exch def
132   dup /YBox              get /YBox              exch def
133   setfont
134 }def
136 /FG /setrgbcolor load def
138 /bg false def
139 /BG{
140   dup /bg exch def
141   {mark 4 1 roll ]}
142   {[ 1.0 1.0 1.0 ]}
143   ifelse
144   /bgcolor exch def
145 }def
147 %  B    width    C
148 %   +-----------+
149 %               | Ascent  (usually > 0)
150 % A +           +
151 %               | Descent (usually < 0)
152 %   +-----------+
153 %  E    width    D
155 /dobackground{                          % width --
156   currentpoint                          % -- width x y
157   gsave
158     newpath
159     moveto                              % A (x y)
160     0 Ascent rmoveto                    % B
161     dup 0 rlineto                       % C
162     0 Descent Ascent sub rlineto        % D
163     neg 0 rlineto                       % E
164     closepath
165     bgcolor aload pop setrgbcolor
166     fill
167   grestore
168 }def
170 /eolbg{                                 % dobackground until right margin
171   PrintWidth                            % -- x-eol
172   currentpoint pop                      % -- cur-x
173   sub                                   % -- width until eol
174   dobackground
175 }def
177 /PLN{PrintLineNumber{doLineNumber}if}def
179 /SL{                                    % Soft Linefeed
180   bg{eolbg}if
181   0  currentpoint exch pop LineHeight sub  moveto
182 }def
184 /HL{SL PLN}def                          % Hard Linefeed
186 % Some debug
187 /dcp{currentpoint exch 40 string cvs print (, ) print =}def
188 /dp{print 2 copy  exch 40 string cvs print (, ) print =}def
191   ( ) stringwidth       % Get the width of a space in the current font.
192   pop                   % Discard the Y component.
193   mul                   % Multiply the width of a space
194                         % by the number of spaces to plot
195   bg{dup dobackground}if
196   0 rmoveto
197 }def
199 /Effect 0 def
200 /EF{/Effect exch def}def
202 % stack:  string  |-  --
203 % effect: 1  - underline  2   - strikeout  4  - overline
204 %         8  - shadow     16  - box        32 - outline
206   /xx currentpoint dup Descent add /yy exch def
207   Ascent add /YY exch def def
208   dup stringwidth pop xx add /XX exch def
209   Effect 8 and 0 ne{
210     /yy yy Yshadow add def
211     /XX XX Xshadow add def
212   }if
213   bg{
214     true
215     Effect 16 and 0 ne
216       {SpaceBackground doBox}
217       {xx yy XX YY doRect}
218     ifelse
219   }if                                           % background
220   Effect 16 and 0 ne{false 0 doBox}if           % box
221   Effect 8  and 0 ne{dup doShadow}if            % shadow
222   Effect 32 and 0 ne
223     {true doOutline}                            % outline
224     {show}                                      % normal text
225   ifelse
226   Effect 1  and 0 ne{UnderlinePosition Hline}if % underline
227   Effect 2  and 0 ne{StrikeoutPosition Hline}if % strikeout
228   Effect 4  and 0 ne{OverlinePosition  Hline}if % overline
229 }bind def
231 % stack:  position  |-  --
232 /Hline{
233   currentpoint exch pop add dup
234   gsave
235   newpath
236   xx exch moveto
237   XX exch lineto
238   closepath
239   LineThickness setlinewidth stroke
240   grestore
241 }bind def
243 % stack:  fill-or-not delta  |-  --
244 /doBox{
245   /dd exch def
246   xx XBox sub dd sub yy YBox sub dd sub
247   XX XBox add dd add YY YBox add dd add
248   doRect
249 }bind def
251 % stack:  fill-or-not lower-x lower-y upper-x upper-y  |-  --
252 /doRect{
253   /rYY exch def
254   /rXX exch def
255   /ryy exch def
256   /rxx exch def
257   gsave
258   newpath
259   rXX rYY moveto
260   rxx rYY lineto
261   rxx ryy lineto
262   rXX ryy lineto
263   closepath
264   % top of stack: fill-or-not
265     {FillBgColor}
266     {LineThickness setlinewidth stroke}
267   ifelse
268   grestore
269 }bind def
271 % stack:  string  |-  --
272 /doShadow{
273   gsave
274   Xshadow Yshadow rmoveto
275   false doOutline
276   grestore
277 }bind def
279 /st 1 string def
281 % stack:  string fill-or-not  |-  --
282 /doOutline{
283   /-fillp- exch def
284   /-ox- currentpoint /-oy- exch def def
285   gsave
286   LineThickness setlinewidth
287   {st 0 3 -1 roll put
288    st dup true charpath
289    -fillp- {gsave FillBgColor grestore}if
290    stroke stringwidth
291    -oy- add /-oy- exch def
292    -ox- add /-ox- exch def
293    -ox- -oy- moveto
294   }forall
295   grestore
296   -ox- -oy- moveto
297 }bind def
299 % stack:  --
300 /FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
302 /L0 6 /Times-Italic DefFont
304 % stack:  --
305 /doLineNumber{
306   /LineNumber where
307   {
308     pop
309     currentfont
310     gsave
311     0.0 0.0 0.0 setrgbcolor
312     /L0 findfont setfont
313     LineNumber Lines ge
314       {(end      )}
315       {LineNumber 6 string cvs (      ) strcat}
316     ifelse
317     dup stringwidth pop neg 0 rmoveto
318     show
319     grestore
320     setfont
321     /LineNumber LineNumber 1 add def
322   }if
323 }def
325 % stack: --
326 /printZebra{
327   gsave
328   ZebraGray setgray
329   /double-zebra ZebraHeight ZebraHeight add def
330   /yiter double-zebra LineHeight mul neg def
331   /xiter PrintWidth InterColumn add def
332   NumberOfColumns{LinesPerColumn doColumnZebra xiter 0 rmoveto}repeat
333   grestore
334 }def
336 % stack:  lines-per-column |- --
337 /doColumnZebra{
338   gsave
339   dup double-zebra idiv{ZebraHeight doZebra 0 yiter rmoveto}repeat
340   double-zebra mod
341   dup 0 le{pop}{dup ZebraHeight gt {pop ZebraHeight}if doZebra}ifelse
342   grestore
343 }def
345 % stack:  zebra-height (in lines) |- --
346 /doZebra{
347   /zh exch 0.05 sub LineHeight mul def
348   gsave
349   0 LineHeight 0.65 mul rmoveto
350   PrintWidth 0 rlineto
351   0 zh neg rlineto
352   PrintWidth neg 0 rlineto
353   0 zh rlineto
354   fill
355   grestore
356 }def
358 % tx ty rotation xscale yscale xpos ypos BeginBackImage
359 /BeginBackImage{
360   /-save-image- save def
361   /showpage{}def
362   translate
363   scale
364   rotate
365   translate
366 }def
368 /EndBackImage{-save-image- restore}def
370 % string fontsize fontname rotation gray xpos ypos ShowBackText
371 /ShowBackText{
372   gsave
373   translate
374   setgray
375   rotate
376   findfont exch dup /-offset- exch -0.25 mul def scalefont setfont
377   0 -offset- moveto
378   /-saveLineThickness- LineThickness def
379   /LineThickness 1 def
380   false doOutline
381   /LineThickness -saveLineThickness- def
382   grestore
383 }def
385 /BeginDoc{
386   % ---- Remember space width of the normal text font `f0'.
387   /SpaceWidth /f0 findfont setfont ( ) stringwidth pop def
388   % ---- save the state of the document (useful for ghostscript!)
389   /docState save def
390   % ---- [andrewi] set PageSize based on chosen dimensions
391   UseSetpagedevice{
392     << /PageSize [PageWidth LandscapePageHeight] >> setpagedevice
393   }{
394     LandscapeMode{
395       % ---- translate to bottom-right corner of Portrait page
396       LandscapePageHeight 0 translate
397       90 rotate
398     }if
399   }ifelse
400   % ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7
401   /JackGhostscript where{pop 1 27.7 29.7 div scale}if
402   % ---- N-Up printing
403   N-Up 1 gt{
404     % ---- landscape
405     N-Up-Landscape{
406       PageWidth 0 translate
407       90 rotate
408     }if
409     N-Up-Margin dup translate
410     % ---- scale
411     LandscapeMode{
412       /HH PageWidth def
413       /WW LandscapePageHeight def
414     }{
415       /HH LandscapePageHeight def
416       /WW PageWidth def
417     }ifelse
418     WW N-Up-Margin sub N-Up-Margin sub
419     N-Up-Landscape
420      {N-Up-Lines div HH}{N-Up-Columns N-Up-Missing add div WW}ifelse
421     div dup scale
422     0 N-Up-Repeat 1 sub LandscapePageHeight mul translate
423     % ---- go to start position in page matrix
424     N-Up-XStart N-Up-Missing 0.5 mul
425     LandscapeMode{
426       LandscapePageHeight mul N-Up-YStart add
427     }{
428       PageWidth mul add N-Up-YStart
429     }ifelse
430     translate
431   }if
432   /ColumnWidth PrintWidth InterColumn add def
433   % ---- translate to lower left corner of TEXT
434   LeftMargin BottomMargin translate
435   % ---- define where  printing will start
436   /f0 F                                 % this installs Ascent
437   /PrintStartY PrintHeight Ascent sub def
438   /ColumnIndex 1 def
439   /N-Up-Counter N-Up-End 1 sub def
440 }def
442 /EndDoc{
443   % ---- restore the state of the document (useful for ghostscript!)
444   docState restore
445 }def
447 /BeginDSCPage{
448   % ---- when 1st column, save the state of the page
449   ColumnIndex 1 eq{
450     /pageState save def
451   }if
452   % ---- save the state of the column
453   /columnState save def
454 }def
456 /PrintHeaderWidth PrintOnlyOneHeader{PrintPageWidth}{PrintWidth}ifelse def
458 /BeginPage{
459   % ---- when 1st column, print all background effects
460   ColumnIndex 1 eq{
461     0 PrintStartY moveto                % move to where printing will start
462     Zebra {printZebra}if
463     printGlobalBackground
464     printLocalBackground
465   }if
466   PrintHeader{
467     PrintOnlyOneHeader{ColumnIndex 1 eq}{true}ifelse{
468       PrintHeaderFrame{HeaderFrame}if
469       HeaderText
470     }if
471   }if
472   0 PrintStartY moveto                  % move to where printing will start
473   PLN
474 }def
476 /EndPage{bg{eolbg}if}def
478 /EndDSCPage{
479   ColumnIndex NumberOfColumns eq{
480     % ---- restore the state of the page
481     pageState restore
482     /ColumnIndex 1 def
483     % ---- N-up printing
484     N-Up 1 gt{
485       N-Up-Counter 0 gt{
486         % ---- Next page on same row
487         /N-Up-Counter N-Up-Counter 1 sub def
488         N-Up-XColumn N-Up-YColumn
489       }{
490         % ---- Next page on next line
491         /N-Up-Counter N-Up-End 1 sub def
492         N-Up-XLine N-Up-YLine
493       }ifelse
494       translate
495     }if
496   }{ % else
497     % ---- restore the state of the current column
498     columnState restore
499     % ---- and translate to the next column
500     ColumnWidth 0 translate
501     /ColumnIndex ColumnIndex 1 add def
502   }ifelse
503 }def
505 % stack: number-of-pages-per-sheet |- --
506 /BeginSheet{
507   /sheetState save def
508   /pages-per-sheet exch def
509   % ---- N-up printing
510   N-Up 1 gt N-Up-Border and pages-per-sheet 0 gt and{
511     % ---- page border
512     gsave
513     0 setgray
514     LeftMargin neg BottomMargin neg moveto
515     N-Up-Repeat
516     {N-Up-End
517      {gsave
518       PageWidth 0 rlineto
519       0 LandscapePageHeight rlineto
520       PageWidth neg 0 rlineto
521       closepath stroke
522       grestore
523       /pages-per-sheet pages-per-sheet 1 sub def
524       pages-per-sheet 0 le{exit}if
525       N-Up-XColumn N-Up-YColumn rmoveto
526      }repeat
527      pages-per-sheet 0 le{exit}if
528      N-Up-XLine N-Up-XColumn sub N-Up-YLine rmoveto
529     }repeat
530     grestore
531   }if
532 }def
534 /EndSheet{
535   showpage
536   sheetState restore
537 }def
539 /SetHeaderLines{                        % nb-lines --
540   /HeaderLines exch def
541   % ---- bottom up
542   HeaderPad
543   HeaderLines 1 sub HeaderLineHeight mul add
544   HeaderTitleLineHeight add
545   HeaderPad add
546   /HeaderHeight exch def
547 }def
549 % |---------|
550 % |  tm     |
551 % |---------|
552 % |  header |
553 % |-+-------| <-- (x y)
554 % |  ho     |
555 % |---------|
556 % |  text   |
557 % |-+-------| <-- (0 0)
558 % |  bm     |
559 % |---------|
561 /HeaderFrameStart{                      % -- x y
562   0  PrintHeight HeaderOffset add
563 }def
565 /HeaderFramePath{
566   PrintHeaderWidth      0                       rlineto
567   0                     HeaderHeight            rlineto
568   PrintHeaderWidth neg  0                       rlineto
569   0                     HeaderHeight neg        rlineto
570 }def
572 /HeaderFrame{
573   gsave
574     0.4 setlinewidth
575     % ---- fill a black rectangle (the shadow of the next one)
576     HeaderFrameStart moveto
577     1 -1 rmoveto
578     HeaderFramePath
579     0 setgray fill
580     % ---- do the next rectangle ...
581     HeaderFrameStart moveto
582     HeaderFramePath
583     gsave 0.9 setgray fill grestore     % filled with grey
584     gsave 0 setgray stroke grestore     % drawn  with black
585   grestore
586 }def
588 /HeaderStart{
589   HeaderFrameStart
590   exch HeaderPad add exch       % horizontal pad
591   % ---- bottom up
592   HeaderPad add                 % vertical   pad
593   HeaderDescent sub
594   HeaderLineHeight HeaderLines 1 sub mul add
595 }def
597 /strcat{
598   dup length 3 -1 roll dup length dup 4 -1 roll add string dup
599   0 5 -1 roll putinterval
600   dup 4 2 roll exch putinterval
601 }def
603 /pagenumberstring{
604   PageNumber 32 string cvs
605   ShowNofN{
606     (/) strcat
607     PageCount 32 string cvs strcat
608   }if
609 }def
611 /HeaderText{
612   HeaderStart moveto
614   HeaderLinesRight HeaderLinesLeft      % -- rightLines leftLines
616   % ---- hack: `PN 1 and'  ==  `PN 2 modulo'
618   % ---- if even page number and duplex, then exchange left and right
619   PageNumber 1 and 0 eq DuplexValue and{exch}if
621   { % ---- process the left lines
622     aload pop
623     exch F
624     gsave
625       dup xcheck{exec}if
626       show
627     grestore
628     0 HeaderLineHeight neg rmoveto
629   }forall
631   HeaderStart moveto
633   { % ---- process the right lines
634     aload pop
635     exch F
636     gsave
637       dup xcheck{exec}if
638       dup stringwidth pop
639       PrintHeaderWidth exch sub HeaderPad 2 mul sub 0 rmoveto
640       show
641     grestore
642     0 HeaderLineHeight neg rmoveto
643   }forall
644 }def
646 /ReportFontInfo{
647   2 copy
648   /t0 3 1 roll DefFont
649   /t0 F
650   /lh FontHeight def
651   /sw ( ) stringwidth pop def
652   /aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch
653   stringwidth pop exch div def
654   /t1 12 /Helvetica-Oblique DefFont
655   /t1 F
656   gsave
657     (languagelevel = ) show
658     gs_languagelevel 32 string cvs show
659   grestore
660   0 FontHeight neg rmoveto
661   gsave
662     (For ) show
663     128 string cvs show
664     ( ) show
665     32 string cvs show
666     ( point, the line height is ) show
667     lh 32 string cvs show
668     (, the space width is ) show
669     sw 32 string cvs show
670     (,) show
671   grestore
672   0 FontHeight neg rmoveto
673   gsave
674     (and a crude estimate of average character width is ) show
675     aw 32 string cvs show
676     (.) show
677   grestore
678   0 FontHeight neg rmoveto
679 }def
681 /cm{ % cm to point
682   72 mul 2.54 div
683 }def
685 /ReportAllFontInfo{
686   FontDirectory
687   { % key = font name  value = font dictionary
688     pop 10 exch ReportFontInfo
689   }forall
690 }def
692 % 3 cm 20 cm moveto  10 /Courier ReportFontInfo  showpage
693 % 3 cm 20 cm moveto  ReportAllFontInfo           showpage
695 % === END ps-print prologue 1