XEmacs compatibility. Doc fix.

[bpt/emacs.git] / etc / ps-prin1.ps

% === BEGIN ps-print prologue 1
% version: 6.0

% Copyright (C) 2000, 2001  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 2, 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; see the file COPYING.  If not, write to the
% Free Software Foundation, Inc., 59 Temple Place - Suite 330,
% Boston, MA 02111-1307, USA.

% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
/ISOLatin1Encoding where{pop}{
% -- The ISO Latin-1 encoding vector isn't known, so define it.
% -- The first half is the same as the standard encoding,
% -- except for minus instead of hyphen at code 055.
/ISOLatin1Encoding
StandardEncoding 0 45 getinterval aload pop
    /minus
StandardEncoding 46 82 getinterval aload pop
%*** NOTE: the following are missing in the Adobe documentation,
%*** but appear in the displayed table:
%*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
% 0200 (128)
    /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
    /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
    /dotlessi/grave/acute/circumflex/tilde/macron/breve/dotaccent
    /dieresis/.notdef/ring/cedilla/.notdef/hungarumlaut/ogonek/caron
% 0240 (160)
    /space/exclamdown/cent/sterling
	/currency/yen/brokenbar/section
    /dieresis/copyright/ordfeminine/guillemotleft
	/logicalnot/hyphen/registered/macron
    /degree/plusminus/twosuperior/threesuperior
	/acute/mu/paragraph/periodcentered
    /cedilla/onesuperior/ordmasculine/guillemotright
	/onequarter/onehalf/threequarters/questiondown
% 0300 (192)
    /Agrave/Aacute/Acircumflex/Atilde
	/Adieresis/Aring/AE/Ccedilla
    /Egrave/Eacute/Ecircumflex/Edieresis
	/Igrave/Iacute/Icircumflex/Idieresis
    /Eth/Ntilde/Ograve/Oacute
	/Ocircumflex/Otilde/Odieresis/multiply
    /Oslash/Ugrave/Uacute/Ucircumflex
	/Udieresis/Yacute/Thorn/germandbls
% 0340 (224)
    /agrave/aacute/acircumflex/atilde
	/adieresis/aring/ae/ccedilla
    /egrave/eacute/ecircumflex/edieresis
	/igrave/iacute/icircumflex/idieresis
    /eth/ntilde/ograve/oacute
	/ocircumflex/otilde/odieresis/divide
    /oslash/ugrave/uacute/ucircumflex
	/udieresis/yacute/thorn/ydieresis
256 packedarray def
}ifelse

/reencodeFontISO{ %def
  dup
  length 12 add dict	% Make a new font (a new dict the same size
			% as the old one) with room for our new symbols.

  begin			% Make the new font the current dictionary.

    % Copy each of the symbols from the old dictionary
    % to the new one except for the font ID.
    {1 index/FID ne{def}{pop pop}ifelse}forall

    % Override the encoding with the ISOLatin1 encoding.
    currentdict/FontType get 0 ne{/Encoding ISOLatin1Encoding def}if

    % Use the font's bounding box to determine the ascent, descent,
    % and overall height; don't forget that these values have to be
    % transformed using the font's matrix.

%          ^    (x2 y2)
%          |       |
%          |       v
%          |  +----+ - -
%          |  |    |   ^
%          |  |    |   | Ascent (usually > 0)
%          |  |    |   |
% (0 0) -> +--+----+-------->
%             |    |   |
%             |    |   v Descent (usually < 0)
% (x1 y1) --> +----+ - -

    currentdict/FontType get 0 ne
    {/FontBBox load aload pop			% -- x1 y1 x2 y2
     FontMatrix transform/Ascent  exch def pop
     FontMatrix transform/Descent exch def pop}
    {/PrimaryFont FDepVector 0 get def
     PrimaryFont/FontBBox get aload pop
     PrimaryFont/FontMatrix get transform/Ascent exch def pop
     PrimaryFont/FontMatrix get transform/Descent exch def pop}ifelse

    /FontHeight Ascent Descent sub def	% use `sub' because descent < 0

    % Define these in case they're not in the FontInfo
    % (also, here they're easier to get to).
    /UnderlinePosition  Descent 0.70 mul def
    /OverlinePosition   Descent UnderlinePosition sub Ascent add def
    /StrikeoutPosition  Ascent 0.30 mul def
    /LineThickness      FontHeight 0.05 mul def
    /Xshadow            FontHeight  0.08 mul def
    /Yshadow            FontHeight -0.09 mul def
    /SpaceBackground    Descent neg UnderlinePosition add def
    /XBox               Descent neg def
    /YBox               LineThickness 0.7 mul def

    currentdict		% Leave the new font on the stack
    end			% Stop using the font as the current dictionary.
    definefont		% Put the font into the font dictionary
    pop			% Discard the returned font.
}bind def

% Font definition
/DefFont{findfont exch scalefont reencodeFontISO}def

% Font selection
/F{
  findfont
  dup/Ascent            get/Ascent            exch def
  dup/Descent           get/Descent           exch def
  dup/FontHeight        get/FontHeight        exch def
  dup/UnderlinePosition get/UnderlinePosition exch def
  dup/OverlinePosition  get/OverlinePosition  exch def
  dup/StrikeoutPosition get/StrikeoutPosition exch def
  dup/LineThickness     get/LineThickness     exch def
  dup/Xshadow           get/Xshadow           exch def
  dup/Yshadow           get/Yshadow           exch def
  dup/SpaceBackground   get/SpaceBackground   exch def
  dup/XBox              get/XBox              exch def
  dup/YBox              get/YBox              exch def
  setfont
}def

/FG/setrgbcolor load def

/bg false def
/BG{
  dup/bg exch def
  {[4 1 roll]}
  {[1.0 1.0 1.0]}
  ifelse
  /bgcolor exch def
}def

%  B    width    C
%   +-----------+
%               | Ascent  (usually > 0)
% A +           +
%               | Descent (usually < 0)
%   +-----------+
%  E    width    D

/dobackground{				% width --
  currentpoint				% -- width x y
  gsave
    newpath
    moveto				% A (x y)
    0 Ascent rmoveto			% B
    dup 0 rlineto			% C
    0 Descent Ascent sub rlineto	% D
    neg 0 rlineto			% E
    closepath
    FillBgColor
  grestore
}def

/eolbg{					% dobackground until right margin
  PrintWidth				% -- x-eol
  currentpoint pop			% -- cur-x
  sub					% -- width until eol
  dobackground
}def

/PSL{bg{eolbg}if  0  currentpoint exch pop LineHeight sub  moveto}def
/PLN{PrintLineNumber{doLineNumber}if}def

/SL{PSL isLineStep pop}def		% Soft Linefeed

/HL{PSL PLN}def				% Hard Linefeed

% Some debug
/dcp{currentpoint exch 40 string cvs print(, )print =}def
/dp{print 2 copy  exch 40 string cvs print(, )print =}def

/W{
  ( )stringwidth	% Get the width of a space in the current font.
  pop			% Discard the Y component.
  mul			% Multiply the width of a space
			% by the number of spaces to plot
  bg{dup dobackground}if
  0 rmoveto
}def

/Effect 0 def
/EF{/Effect exch def}def

% stack:  string  |-  --
% effect: 1  - underline  2   - strikeout  4  - overline
%         8  - shadow     16  - box        32 - outline
/S{
  /xx currentpoint dup Descent add/yy exch def
  Ascent add/YY exch def def
  dup stringwidth pop xx add/XX exch def
  Effect 8 and 0 ne{
    /yy yy Yshadow add def
    /XX XX Xshadow add def
  }if
  bg{
    true
    Effect 16 and 0 ne
      {SpaceBackground doBox}
      {xx yy XX YY doRect}
    ifelse
  }if						% background
  Effect 16 and 0 ne{false 0 doBox}if		% box
  Effect 8  and 0 ne{dup doShadow}if		% shadow
  Effect 32 and 0 ne
    {true doOutline}				% outline
    {show}					% normal text
  ifelse
  Effect 1  and 0 ne{UnderlinePosition Hline}if	% underline
  Effect 2  and 0 ne{StrikeoutPosition Hline}if	% strikeout
  Effect 4  and 0 ne{OverlinePosition  Hline}if	% overline
}bind def

% stack:  position  |-  --
/Hline{
  currentpoint exch pop add dup
  gsave
  newpath
  xx exch moveto
  XX exch lineto
  closepath
  LineThickness setlinewidth stroke
  grestore
}bind def

% stack:  fill-or-not delta  |-  --
/doBox{
  /dd exch def
  xx XBox sub dd sub yy YBox sub dd sub
  XX XBox add dd add YY YBox add dd add
  doRect
}bind def

% stack:  fill-or-not lower-x lower-y upper-x upper-y  |-  --
/doRect{
  /rYY exch def
  /rXX exch def
  /ryy exch def
  /rxx exch def
  gsave
  newpath
  rXX rYY moveto
  rxx rYY lineto
  rxx ryy lineto
  rXX ryy lineto
  closepath
  % top of stack: fill-or-not
  {FillBgColor}
  {LineThickness setlinewidth stroke}ifelse
  grestore
}bind def

% stack:  string  |-  --
/doShadow{
  gsave
  Xshadow Yshadow rmoveto
  false doOutline
  grestore
}bind def

/st 1 string def

% stack:  string fill-or-not  |-  --
/doOutline{
  /-fillp- exch def
  /-ox- currentpoint/-oy- exch def def
  gsave
  LineThickness setlinewidth
  {st 0 3 -1 roll put
   st dup true charpath
   -fillp- {gsave FillBgColor grestore}if
   stroke stringwidth
   -oy- add/-oy- exch def
   -ox- add/-ox- exch def
   -ox- -oy- moveto
  }forall
  grestore
  -ox- -oy- moveto
}bind def

% stack:  --
/FillBgColor{bgcolor aload pop setrgbcolor fill}bind def

% stack:  -- |- boolean
/isLineStep{
  SyncLineZebra
  {PLScounter 0 gt						% or zebra
   {/PLScounter PLScounter 1 sub def PLScounter 0 eq}
   {false}ifelse
   PrintLineStep 1 gt
   {/PrintLineStep PrintLineStep 1 sub def}
   {/PrintLineStep ZebraHeight def
    /PLScounter PrintLineStart def}ifelse}
  {LineNumber PrintLineStart sub PrintLineStep mod 0 eq}ifelse	% or line step
}def

% stack:  --
/doLineNumber{
  /LineNumber where
  {pop
   isLineStep			% or line step
   LineNumber Lines ge or	% or last line
   {currentfont
    gsave
    0.0 0.0 0.0 setrgbcolor
    /L0 findfont setfont
    LineNumber Lines ge
    {(end      )}
    {LineNumber 6 string cvs(      )strcat}ifelse
    dup stringwidth pop neg 0 rmoveto
    show
    grestore
    setfont}if
    /LineNumber LineNumber 1 add def
  }if
}def

% stack: color-specifier |- --
/SetColor{dup type/realtype eq{setgray}{aload pop setrgbcolor}ifelse}def

% stack: --
/printZebra{
  gsave
  ZebraColor SetColor
  /double-zebra ZebraHeight ZebraHeight add def
  /yiter double-zebra LineHeight mul neg def
  /xiter PrintWidth InterColumn add def
  /zebra-line LinesPrinted def
  NumberOfColumns{LinesPerColumn doColumnZebra xiter 0 rmoveto}repeat
  grestore
}def

% stack:  lines-per-column |- --
/doColumnZebra{
  /lpc exch def
  gsave
  ZebraFollow 1 and 0 ne{
    /H ZebraHeight zebra-line ZebraHeight mod sub def
    /lpc lpc H sub def
    zebra-line double-zebra mod ZebraHeight lt
    {H doZebra	% "black" stripe followed by a "white" stripe
     /lpc lpc ZebraHeight sub def
     H ZebraHeight add}
    {H}ifelse	% "white" stripe
    LineHeight mul neg 0 exch rmoveto
    /zebra-line zebra-line LinesPerColumn add def
  }if
  lpc dup double-zebra idiv{ZebraHeight doZebra 0 yiter rmoveto}repeat
  double-zebra mod dup 0 le{pop}
  {dup ZebraHeight gt ZebraFollow 2 and 0 ne or{pop ZebraHeight}if doZebra}ifelse
  grestore
}def

% stack:  zebra-height (in lines) |- --
/doZebra{
  /zh exch 0.05 sub LineHeight mul def
  gsave
  0 LineHeight 0.65 mul rmoveto
  PrintWidth 0 rlineto
  0 zh neg rlineto
  PrintWidth neg 0 rlineto
  0 zh rlineto
  fill
  grestore
}def

% stack: --
/printBackground{
  /BackgroundColor where{
    pop gsave BackgroundColor SetColor
    NumberOfColumns{
     gsave
     0 LineHeight 0.65 mul rmoveto
     PrintWidth 0 rlineto
     0 PrintHeight neg rlineto
     PrintWidth neg 0 rlineto
     0 PrintHeight rlineto
     fill
     grestore
     PrintWidth InterColumn add 0 rmoveto
    }repeat
    grestore
  }if
}def

% tx ty rotation xscale yscale xpos ypos BeginBackImage
/BeginBackImage{
  /-save-image- save def
  /showpage{}def
  translate
  scale
  rotate
  translate
}def

/EndBackImage{-save-image- restore}def

% string fontsize fontname rotation gray xpos ypos ShowBackText
/ShowBackText{
  gsave
  translate
  setgray
  rotate
  findfont exch dup/-offset- exch -0.25 mul def scalefont setfont
  0 -offset- moveto
  /-saveLineThickness- LineThickness def
  /LineThickness 1 def
  false doOutline
  /LineThickness -saveLineThickness- def
  grestore
}def

/SetPageSize{
  BMark/PageSize[PageWidth LandscapePageHeight LandscapeMode{exch}if]EMark setpagedevice
}def

/BeginDoc{
  % ---- Remember space width of the normal text font `f0'.
  /SpaceWidth/f0 findfont setfont( )stringwidth pop def
  % ---- save the state of the document (useful for ghostscript!)
  /docState save def
  % ---- [andrewi] set PageSize based on chosen dimensions
  UseSetpagedevice{
   WarnPaperSize{SetPageSize}{mark{SetPageSize}stopped cleartomark}ifelse
  }if
  /ColumnWidth PrintWidth InterColumn add def
  % ---- define where  printing will start
  /f0 F					% this installs Ascent
  /PrintStartY PrintHeight Ascent sub def
  /ColumnIndex 1 def
  /N-Up-Counter N-Up-End 1 sub def
  /PLScounter PrintLineStart def
}def

/EndDoc{
  % ---- restore the state of the document (useful for ghostscript!)
  docState restore
}def

/BeginDSCPage{
  % ---- when 1st column, save the state of the page
  ColumnIndex 1 eq{/pageState save def}if
  % ---- save the state of the column
  /columnState save def
}def

/PrintHeaderWidth PrintOnlyOneHeader{PrintPageWidth}{PrintWidth}ifelse def

/BeginPage{
  /LinesPrinted exch def
  % ---- when 1st column, print all background effects
  ColumnIndex 1 eq{
    0 PrintStartY moveto		% move to where printing will start
    printBackground
    Zebra{printZebra}if
    printGlobalBackground
    printLocalBackground
  }if
  PrintHeader{
    PrintOnlyOneHeader{ColumnIndex 1 eq}{true}ifelse{
      PrintHeaderFrame{HeaderFrame}if
      HeaderText
    }if
  }if
  0 PrintStartY moveto			% move to where printing will start
  /LineNumber where
  {pop
   SyncLineZebra
   {/H PageNumber 1 sub NumberOfColumns mul ColumnIndex 1 sub add
       LinesPerColumn mul ZebraHeight mod def
    /PLScounter H PrintLineStart ge{0}{PrintLineStart H sub}ifelse def
    /PrintLineStep ZebraHeight H sub def}if}if
  PLN
}def

/EndPage{bg{eolbg}if}def

/EndDSCPage{
  ColumnIndex NumberOfColumns eq{
    % ---- restore the state of the page
    pageState restore
    /ColumnIndex 1 def
    % ---- N-up printing
    N-Up 1 gt{
      N-Up-Counter 0 gt
      {% ---- Next page on same row
	/N-Up-Counter N-Up-Counter 1 sub def
	N-Up-XColumn N-Up-YColumn}
      {% ---- Next page on next line
	/N-Up-Counter N-Up-End 1 sub def
	N-Up-XLine N-Up-YLine}ifelse
      translate
    }if
  }{ % else
    % ---- restore the state of the current column
    columnState restore
    % ---- and translate to the next column
    ColumnWidth 0 translate
    /ColumnIndex ColumnIndex 1 add def
  }ifelse
}def

% stack: number-of-pages-per-sheet |- --
/BeginSheet{
  /sheetState save def
  /pages-per-sheet exch def

  % ---- translate to bottom-right corner of Portrait page
  LandscapeMode{
    LandscapePageHeight 0 translate
    90 rotate
  }if
  % ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7
  /JackGhostscript where{pop 1 27.7 29.7 div scale}if
  UpsideDown{PageWidth LandscapePageHeight translate 180 rotate}if
  % ---- N-Up printing
  N-Up 1 gt{
    % ---- landscape
    N-Up-Landscape{
      PageWidth 0 translate
      90 rotate
    }if
    N-Up-Margin dup translate
    % ---- scale
    LandscapeMode{
      /HH PageWidth def
      /WW LandscapePageHeight def
    }{
      /HH LandscapePageHeight def
      /WW PageWidth def
    }ifelse
    /xx 0 def
    N-Up-Landscape{
      /ww WW WW mul N-Up-Lines HH mul div def
      /cc HH N-Up-Columns N-Up-Missing add div def
      ww cc gt{/xx WW def/WW cc ww div WW mul def/xx xx WW sub def}if
    }{
      /hh HH N-Up-Columns N-Up-Missing add div def
      /cc HH N-Up-Lines div def
      hh cc gt{/xx WW def/WW cc hh div WW mul def/xx xx WW sub def}if
    }ifelse
    WW N-Up-Margin sub N-Up-Margin sub
    N-Up-Landscape
    {N-Up-Lines div HH}
    {N-Up-Columns N-Up-Missing add div WW}ifelse
    div dup scale
    LandscapeMode{/yy 0 def}{/yy xx def/xx 0 def}ifelse
    xx N-Up-Repeat 1 sub LandscapePageHeight mul yy add translate
    % ---- go to start position in page matrix
    N-Up-XStart N-Up-Missing 0.5 mul
    LandscapeMode
    {LandscapePageHeight mul N-Up-YStart add}
    {PageWidth mul add N-Up-YStart}ifelse
    translate
  }if
  % ---- translate to lower left corner of TEXT
  LeftMargin BottomMargin translate

  % ---- N-up printing
  N-Up 1 gt N-Up-Border and pages-per-sheet 0 gt and{
    % ---- page border
    gsave
    0 setgray
    LeftMargin neg BottomMargin neg moveto
    N-Up-Repeat
    {N-Up-End
     {gsave
      PageWidth 0 rlineto
      0 LandscapePageHeight rlineto
      PageWidth neg 0 rlineto
      closepath stroke
      grestore
      /pages-per-sheet pages-per-sheet 1 sub def
      pages-per-sheet 0 le{exit}if
      N-Up-XColumn N-Up-YColumn rmoveto
     }repeat
     pages-per-sheet 0 le{exit}if
     N-Up-XLine N-Up-XColumn sub N-Up-YLine rmoveto
    }repeat
    grestore
  }if
}def

/EndSheet{
  showpage
  sheetState restore
}def

/SetHeaderLines{			% nb-lines --
  /HeaderLines exch def
  % ---- bottom up
  HeaderPad
  HeaderLines 1 sub HeaderLineHeight mul add
  HeaderTitleLineHeight add
  HeaderPad add
  /HeaderHeight exch def
}def

% |---------|
% |  tm     |
% |---------|
% |  header |
% |-+-------| <-- (x y)
% |  ho     |
% |---------|
% |  text   |
% |-+-------| <-- (0 0)
% |  bm     |
% |---------|

% -- |- x y
/HeaderFrameStart{0  PrintHeight HeaderOffset add}def

/HeaderFramePath{
  PrintHeaderWidth	0			rlineto
  0			HeaderHeight		rlineto
  PrintHeaderWidth neg	0			rlineto
  0			HeaderHeight neg	rlineto
}def

/HeaderFrame{
  gsave
    0.4 setlinewidth
    % ---- fill a black rectangle (the shadow of the next one)
    HeaderFrameStart moveto
    1 -1 rmoveto
    HeaderFramePath
    0 setgray fill
    % ---- do the next rectangle ...
    HeaderFrameStart moveto
    HeaderFramePath
    gsave 0.9 setgray fill grestore	% filled with grey
    gsave 0 setgray stroke grestore	% drawn  with black
  grestore
}def

/HeaderStart{
  HeaderFrameStart
  exch HeaderPad add exch	% horizontal pad
  % ---- bottom up
  HeaderPad add			% vertical   pad
  HeaderDescent sub
  HeaderLineHeight HeaderLines 1 sub mul add
}def

/strcat{
  dup length 3 -1 roll dup length dup 4 -1 roll add string dup
  0 5 -1 roll putinterval
  dup 4 2 roll exch putinterval
}def

/pagenumberstring{
  PageNumber 32 string cvs
  ShowNofN{(/)strcat PageCount 32 string cvs strcat}if
}def

/HeaderText{
  HeaderStart moveto

  HeaderLinesRight HeaderLinesLeft	% -- rightLines leftLines

  % ---- hack: `PN 1 and'  ==  `PN 2 modulo'

  % ---- if even page number and duplex, then exchange left and right
  PageNumber 1 and 0 eq SwitchHeader and{exch}if

  { % ---- process the left lines
    aload pop
    exch F
    gsave
      dup xcheck{exec}if
      show
    grestore
    0 HeaderLineHeight neg rmoveto
  }forall

  HeaderStart moveto

  { % ---- process the right lines
    aload pop
    exch F
    gsave
      dup xcheck{exec}if
      dup stringwidth pop
      PrintHeaderWidth exch sub HeaderPad 2 mul sub 0 rmoveto
      show
    grestore
    0 HeaderLineHeight neg rmoveto
  }forall
}def

/ReportFontInfo{
  2 copy
  /t0 3 1 roll DefFont
  /t0 F
  /lh FontHeight def
  /sw( )stringwidth pop def
  /aw(01234567890abcdefghijklmnopqrstuvwxyz)dup length exch
  stringwidth pop exch div def
  /t1 12/Helvetica-Oblique DefFont
  /t1 F
  gsave
    (languagelevel = )show
    languagelevel 32 string cvs show
  grestore
  0 FontHeight neg rmoveto
  gsave
    (For )show
    128 string cvs show
    ( )show
    32 string cvs show
    ( point, the line height is )show
    lh 32 string cvs show
    (, the space width is )show
    sw 32 string cvs show
    (,)show
  grestore
  0 FontHeight neg rmoveto
  gsave
    (and a crude estimate of average character width is )show
    aw 32 string cvs show
    (.)show
  grestore
  0 FontHeight neg rmoveto
}def

% cm to point
/cm{72 mul 2.54 div}def

/ReportAllFontInfo{
  % key = font name   value = font dictionary
  FontDirectory{pop 10 exch ReportFontInfo}forall
}def

% 3 cm 20 cm moveto  10/Courier ReportFontInfo  showpage
% 3 cm 20 cm moveto  ReportAllFontInfo          showpage

% === END ps-print prologue 1