(lisp-mode-variables): Set comment-add.
[emacs.git] / etc / ps-prin1.ps
bloba2fc98ac4b435a75ae1c84049feabb7218e60a84
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     FillBgColor
166   grestore
167 }def
169 /eolbg{                                 % dobackground until right margin
170   PrintWidth                            % -- x-eol
171   currentpoint pop                      % -- cur-x
172   sub                                   % -- width until eol
173   dobackground
174 }def
176 /PSL{bg{eolbg}if  0  currentpoint exch pop LineHeight sub  moveto}def
177 /PLN{PrintLineNumber{doLineNumber}if}def
179 /SL{PSL isLineStep pop}def              % Soft Linefeed
181 /HL{PSL PLN}def                         % Hard Linefeed
183 % Some debug
184 /dcp{currentpoint exch 40 string cvs print (, ) print =}def
185 /dp{print 2 copy  exch 40 string cvs print (, ) print =}def
188   ( ) stringwidth       % Get the width of a space in the current font.
189   pop                   % Discard the Y component.
190   mul                   % Multiply the width of a space
191                         % by the number of spaces to plot
192   bg{dup dobackground}if
193   0 rmoveto
194 }def
196 /Effect 0 def
197 /EF{/Effect exch def}def
199 % stack:  string  |-  --
200 % effect: 1  - underline  2   - strikeout  4  - overline
201 %         8  - shadow     16  - box        32 - outline
203   /xx currentpoint dup Descent add /yy exch def
204   Ascent add /YY exch def def
205   dup stringwidth pop xx add /XX exch def
206   Effect 8 and 0 ne{
207     /yy yy Yshadow add def
208     /XX XX Xshadow add def
209   }if
210   bg{
211     true
212     Effect 16 and 0 ne
213       {SpaceBackground doBox}
214       {xx yy XX YY doRect}
215     ifelse
216   }if                                           % background
217   Effect 16 and 0 ne{false 0 doBox}if           % box
218   Effect 8  and 0 ne{dup doShadow}if            % shadow
219   Effect 32 and 0 ne
220     {true doOutline}                            % outline
221     {show}                                      % normal text
222   ifelse
223   Effect 1  and 0 ne{UnderlinePosition Hline}if % underline
224   Effect 2  and 0 ne{StrikeoutPosition Hline}if % strikeout
225   Effect 4  and 0 ne{OverlinePosition  Hline}if % overline
226 }bind def
228 % stack:  position  |-  --
229 /Hline{
230   currentpoint exch pop add dup
231   gsave
232   newpath
233   xx exch moveto
234   XX exch lineto
235   closepath
236   LineThickness setlinewidth stroke
237   grestore
238 }bind def
240 % stack:  fill-or-not delta  |-  --
241 /doBox{
242   /dd exch def
243   xx XBox sub dd sub yy YBox sub dd sub
244   XX XBox add dd add YY YBox add dd add
245   doRect
246 }bind def
248 % stack:  fill-or-not lower-x lower-y upper-x upper-y  |-  --
249 /doRect{
250   /rYY exch def
251   /rXX exch def
252   /ryy exch def
253   /rxx exch def
254   gsave
255   newpath
256   rXX rYY moveto
257   rxx rYY lineto
258   rxx ryy lineto
259   rXX ryy lineto
260   closepath
261   % top of stack: fill-or-not
262     {FillBgColor}
263     {LineThickness setlinewidth stroke}
264   ifelse
265   grestore
266 }bind def
268 % stack:  string  |-  --
269 /doShadow{
270   gsave
271   Xshadow Yshadow rmoveto
272   false doOutline
273   grestore
274 }bind def
276 /st 1 string def
278 % stack:  string fill-or-not  |-  --
279 /doOutline{
280   /-fillp- exch def
281   /-ox- currentpoint /-oy- exch def def
282   gsave
283   LineThickness setlinewidth
284   {st 0 3 -1 roll put
285    st dup true charpath
286    -fillp- {gsave FillBgColor grestore}if
287    stroke stringwidth
288    -oy- add /-oy- exch def
289    -ox- add /-ox- exch def
290    -ox- -oy- moveto
291   }forall
292   grestore
293   -ox- -oy- moveto
294 }bind def
296 % stack:  --
297 /FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
299 /L0 6 /Times-Italic DefFont
301 % stack:  -- |- boolean
302 /isLineStep{
303   SyncLineZebra
304   {PLScounter 0 gt                                              % or zebra
305    {/PLScounter PLScounter 1 sub def PLScounter 0 eq}
306    {false}ifelse
307    PrintLineStep 1 gt
308    {/PrintLineStep PrintLineStep 1 sub def}
309    {/PrintLineStep ZebraHeight def
310     /PLScounter PrintLineStart def}ifelse}
311   {LineNumber PrintLineStart sub PrintLineStep mod 0 eq}ifelse  % or line step
312 }def
314 % stack:  --
315 /doLineNumber{
316   /LineNumber where
317   {pop
318    isLineStep                   % or line step
319    LineNumber Lines ge or       % or last line
320    {currentfont
321     gsave
322     0.0 0.0 0.0 setrgbcolor
323     /L0 findfont setfont
324     LineNumber Lines ge
325     {(end      )}
326     {LineNumber 6 string cvs (      ) strcat}ifelse
327     dup stringwidth pop neg 0 rmoveto
328     show
329     grestore
330     setfont}if
331     /LineNumber LineNumber 1 add def
332   }if
333 }def
335 % stack: color-specifier |- --
336 /SetColor{dup type /realtype eq{setgray}{aload pop setrgbcolor}ifelse}def
338 % stack: --
339 /printZebra{
340   gsave
341   ZebraColor SetColor
342   /double-zebra ZebraHeight ZebraHeight add def
343   /yiter double-zebra LineHeight mul neg def
344   /xiter PrintWidth InterColumn add def
345   NumberOfColumns{LinesPerColumn doColumnZebra xiter 0 rmoveto}repeat
346   grestore
347 }def
349 % stack:  lines-per-column |- --
350 /doColumnZebra{
351   gsave
352   dup double-zebra idiv{ZebraHeight doZebra 0 yiter rmoveto}repeat
353   double-zebra mod
354   dup 0 le{pop}{dup ZebraHeight gt {pop ZebraHeight}if doZebra}ifelse
355   grestore
356 }def
358 % stack:  zebra-height (in lines) |- --
359 /doZebra{
360   /zh exch 0.05 sub LineHeight mul def
361   gsave
362   0 LineHeight 0.65 mul rmoveto
363   PrintWidth 0 rlineto
364   0 zh neg rlineto
365   PrintWidth neg 0 rlineto
366   0 zh rlineto
367   fill
368   grestore
369 }def
371 % stack: --
372 /printBackground{
373   /BackgroundColor where{
374     pop gsave BackgroundColor SetColor
375     NumberOfColumns{
376      gsave
377      0 LineHeight 0.65 mul rmoveto
378      PrintWidth 0 rlineto
379      0 PrintHeight neg rlineto
380      PrintWidth neg 0 rlineto
381      0 PrintHeight rlineto
382      fill
383      grestore
384      PrintWidth InterColumn add 0 rmoveto
385     }repeat
386     grestore
387   }if
388 }def
390 % tx ty rotation xscale yscale xpos ypos BeginBackImage
391 /BeginBackImage{
392   /-save-image- save def
393   /showpage{}def
394   translate
395   scale
396   rotate
397   translate
398 }def
400 /EndBackImage{-save-image- restore}def
402 % string fontsize fontname rotation gray xpos ypos ShowBackText
403 /ShowBackText{
404   gsave
405   translate
406   setgray
407   rotate
408   findfont exch dup /-offset- exch -0.25 mul def scalefont setfont
409   0 -offset- moveto
410   /-saveLineThickness- LineThickness def
411   /LineThickness 1 def
412   false doOutline
413   /LineThickness -saveLineThickness- def
414   grestore
415 }def
417 /BeginDoc{
418   % ---- Remember space width of the normal text font `f0'.
419   /SpaceWidth /f0 findfont setfont ( ) stringwidth pop def
420   % ---- save the state of the document (useful for ghostscript!)
421   /docState save def
422   % ---- [andrewi] set PageSize based on chosen dimensions
423   UseSetpagedevice{
424     BMark/PageSize[PageWidth LandscapePageHeight LandscapeMode{exch}if]EMark setpagedevice
425   }if
426   /ColumnWidth PrintWidth InterColumn add def
427   % ---- define where  printing will start
428   /f0 F                                 % this installs Ascent
429   /PrintStartY PrintHeight Ascent sub def
430   /ColumnIndex 1 def
431   /N-Up-Counter N-Up-End 1 sub def
432   /PLScounter PrintLineStart def
433 }def
435 /EndDoc{
436   % ---- restore the state of the document (useful for ghostscript!)
437   docState restore
438 }def
440 /BeginDSCPage{
441   % ---- when 1st column, save the state of the page
442   ColumnIndex 1 eq{
443     /pageState save def
444   }if
445   % ---- save the state of the column
446   /columnState save def
447 }def
449 /PrintHeaderWidth PrintOnlyOneHeader{PrintPageWidth}{PrintWidth}ifelse def
451 /BeginPage{
452   % ---- when 1st column, print all background effects
453   ColumnIndex 1 eq{
454     0 PrintStartY moveto                % move to where printing will start
455     printBackground
456     Zebra {printZebra}if
457     printGlobalBackground
458     printLocalBackground
459   }if
460   PrintHeader{
461     PrintOnlyOneHeader{ColumnIndex 1 eq}{true}ifelse{
462       PrintHeaderFrame{HeaderFrame}if
463       HeaderText
464     }if
465   }if
466   0 PrintStartY moveto                  % move to where printing will start
467   PLN
468 }def
470 /EndPage{bg{eolbg}if}def
472 /EndDSCPage{
473   ColumnIndex NumberOfColumns eq{
474     % ---- restore the state of the page
475     pageState restore
476     /ColumnIndex 1 def
477     % ---- N-up printing
478     N-Up 1 gt{
479       N-Up-Counter 0 gt{
480         % ---- Next page on same row
481         /N-Up-Counter N-Up-Counter 1 sub def
482         N-Up-XColumn N-Up-YColumn
483       }{
484         % ---- Next page on next line
485         /N-Up-Counter N-Up-End 1 sub def
486         N-Up-XLine N-Up-YLine
487       }ifelse
488       translate
489     }if
490   }{ % else
491     % ---- restore the state of the current column
492     columnState restore
493     % ---- and translate to the next column
494     ColumnWidth 0 translate
495     /ColumnIndex ColumnIndex 1 add def
496   }ifelse
497 }def
499 % stack: number-of-pages-per-sheet |- --
500 /BeginSheet{
501   /sheetState save def
502   /pages-per-sheet exch def
504   % ---- translate to bottom-right corner of Portrait page
505   LandscapeMode{
506     LandscapePageHeight 0 translate
507     90 rotate
508   }if
509   % ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7
510   /JackGhostscript where{pop 1 27.7 29.7 div scale}if
511   UpsideDown{PageWidth LandscapePageHeight translate 180 rotate}if
512   % ---- N-Up printing
513   N-Up 1 gt{
514     % ---- landscape
515     N-Up-Landscape{
516       PageWidth 0 translate
517       90 rotate
518     }if
519     N-Up-Margin dup translate
520     % ---- scale
521     LandscapeMode{
522       /HH PageWidth def
523       /WW LandscapePageHeight def
524     }{
525       /HH LandscapePageHeight def
526       /WW PageWidth def
527     }ifelse
528     WW N-Up-Margin sub N-Up-Margin sub
529     N-Up-Landscape
530      {N-Up-Lines div HH}{N-Up-Columns N-Up-Missing add div WW}ifelse
531     div dup scale
532     0 N-Up-Repeat 1 sub LandscapePageHeight mul translate
533     % ---- go to start position in page matrix
534     N-Up-XStart N-Up-Missing 0.5 mul
535     LandscapeMode
536     {LandscapePageHeight mul N-Up-YStart add}
537     {PageWidth mul add N-Up-YStart}ifelse
538     translate
539   }if
540   % ---- translate to lower left corner of TEXT
541   LeftMargin BottomMargin translate
543   % ---- N-up printing
544   N-Up 1 gt N-Up-Border and pages-per-sheet 0 gt and{
545     % ---- page border
546     gsave
547     0 setgray
548     LeftMargin neg BottomMargin neg moveto
549     N-Up-Repeat
550     {N-Up-End
551      {gsave
552       PageWidth 0 rlineto
553       0 LandscapePageHeight rlineto
554       PageWidth neg 0 rlineto
555       closepath stroke
556       grestore
557       /pages-per-sheet pages-per-sheet 1 sub def
558       pages-per-sheet 0 le{exit}if
559       N-Up-XColumn N-Up-YColumn rmoveto
560      }repeat
561      pages-per-sheet 0 le{exit}if
562      N-Up-XLine N-Up-XColumn sub N-Up-YLine rmoveto
563     }repeat
564     grestore
565   }if
566 }def
568 /EndSheet{
569   showpage
570   sheetState restore
571 }def
573 /SetHeaderLines{                        % nb-lines --
574   /HeaderLines exch def
575   % ---- bottom up
576   HeaderPad
577   HeaderLines 1 sub HeaderLineHeight mul add
578   HeaderTitleLineHeight add
579   HeaderPad add
580   /HeaderHeight exch def
581 }def
583 % |---------|
584 % |  tm     |
585 % |---------|
586 % |  header |
587 % |-+-------| <-- (x y)
588 % |  ho     |
589 % |---------|
590 % |  text   |
591 % |-+-------| <-- (0 0)
592 % |  bm     |
593 % |---------|
595 /HeaderFrameStart{                      % -- x y
596   0  PrintHeight HeaderOffset add
597 }def
599 /HeaderFramePath{
600   PrintHeaderWidth      0                       rlineto
601   0                     HeaderHeight            rlineto
602   PrintHeaderWidth neg  0                       rlineto
603   0                     HeaderHeight neg        rlineto
604 }def
606 /HeaderFrame{
607   gsave
608     0.4 setlinewidth
609     % ---- fill a black rectangle (the shadow of the next one)
610     HeaderFrameStart moveto
611     1 -1 rmoveto
612     HeaderFramePath
613     0 setgray fill
614     % ---- do the next rectangle ...
615     HeaderFrameStart moveto
616     HeaderFramePath
617     gsave 0.9 setgray fill grestore     % filled with grey
618     gsave 0 setgray stroke grestore     % drawn  with black
619   grestore
620 }def
622 /HeaderStart{
623   HeaderFrameStart
624   exch HeaderPad add exch       % horizontal pad
625   % ---- bottom up
626   HeaderPad add                 % vertical   pad
627   HeaderDescent sub
628   HeaderLineHeight HeaderLines 1 sub mul add
629 }def
631 /strcat{
632   dup length 3 -1 roll dup length dup 4 -1 roll add string dup
633   0 5 -1 roll putinterval
634   dup 4 2 roll exch putinterval
635 }def
637 /pagenumberstring{
638   PageNumber 32 string cvs
639   ShowNofN{
640     (/) strcat
641     PageCount 32 string cvs strcat
642   }if
643 }def
645 /HeaderText{
646   HeaderStart moveto
648   HeaderLinesRight HeaderLinesLeft      % -- rightLines leftLines
650   % ---- hack: `PN 1 and'  ==  `PN 2 modulo'
652   % ---- if even page number and duplex, then exchange left and right
653   PageNumber 1 and 0 eq DuplexValue and{exch}if
655   { % ---- process the left lines
656     aload pop
657     exch F
658     gsave
659       dup xcheck{exec}if
660       show
661     grestore
662     0 HeaderLineHeight neg rmoveto
663   }forall
665   HeaderStart moveto
667   { % ---- process the right lines
668     aload pop
669     exch F
670     gsave
671       dup xcheck{exec}if
672       dup stringwidth pop
673       PrintHeaderWidth exch sub HeaderPad 2 mul sub 0 rmoveto
674       show
675     grestore
676     0 HeaderLineHeight neg rmoveto
677   }forall
678 }def
680 /ReportFontInfo{
681   2 copy
682   /t0 3 1 roll DefFont
683   /t0 F
684   /lh FontHeight def
685   /sw ( ) stringwidth pop def
686   /aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch
687   stringwidth pop exch div def
688   /t1 12 /Helvetica-Oblique DefFont
689   /t1 F
690   gsave
691     (languagelevel = ) show
692     languagelevel 32 string cvs show
693   grestore
694   0 FontHeight neg rmoveto
695   gsave
696     (For ) show
697     128 string cvs show
698     ( ) show
699     32 string cvs show
700     ( point, the line height is ) show
701     lh 32 string cvs show
702     (, the space width is ) show
703     sw 32 string cvs show
704     (,) show
705   grestore
706   0 FontHeight neg rmoveto
707   gsave
708     (and a crude estimate of average character width is ) show
709     aw 32 string cvs show
710     (.) show
711   grestore
712   0 FontHeight neg rmoveto
713 }def
715 /cm{ % cm to point
716   72 mul 2.54 div
717 }def
719 /ReportAllFontInfo{
720   FontDirectory
721   { % key = font name  value = font dictionary
722     pop 10 exch ReportFontInfo
723   }forall
724 }def
726 % 3 cm 20 cm moveto  10 /Courier ReportFontInfo  showpage
727 % 3 cm 20 cm moveto  ReportAllFontInfo           showpage
729 % === END ps-print prologue 1