Anonymous avatar Anonymous committed 64ee66d

2002-01-09 Steve Youngs <youngs@xemacs.org>;

* package-compile.el (package-directory-map): Change
'ps-print-nomule' to 'ps-print'.

* xemacs-packages/Makefile (PACKAGES): Ditto.

2002-01-09 Steve Youngs <youngs@xemacs.org>;

* Makefile (ELCS): Remove 'lpr.elc' as it's now in 'ps-print'

2002-01-05 Steve Youngs <youngs@xemacs.org>;

* lpr.el (lpr-windows-system): Add autoload cookie.
(lpr-lp-system): Ditto.

2001-12-23 Steve Youngs <youngs@xemacs.org>;

* Makefile: Initial version.

* package-info.in: Initial version.

Comments (0)

Files changed (13)

+_pkg.el
+auto-autoloads.el
+custom-load.el
+package-info
+2002-01-05  Steve Youngs  <youngs@xemacs.org>
+
+	* lpr.el (lpr-windows-system): Add autoload cookie.
+	(lpr-lp-system): Ditto.
+
+2001-12-23  Steve Youngs  <youngs@xemacs.org>
+
+	* Makefile: Initial version.
+
+	* package-info.in: Initial version.
+
+# Makefile for ps-print lisp code
+
+# This file is part of XEmacs.
+
+# XEmacs 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.
+
+# XEmacs 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 XEmacs; see the file COPYING.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+# This XEmacs package contains independent single file lisp packages
+
+VERSION = 1.00
+AUTHOR_VERSION = 6.5.6
+MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
+PACKAGE = ps-print
+PKG_TYPE = regular
+REQUIRES = text-modes
+CATEGORY = standard
+
+ELCS = lpr.elc ps-print.elc
+
+ifeq ($(BUILD_WITHOUT_MULE),)
+ELCS += ps-mule.elc ps-bdf.elc
+endif
+
+EXTRA_SOURCES = README ps-print-20.new ps-print-21.new
+
+DATA_FILES = $(wildcard etc/ps-print/*)
+DATA_DEST = $(PACKAGE)
+
+include ../../XEmacs.rules
+
+GENERATED += custom-load.elc
+
+PRELOADS = -eval "(setq ps-postscript-code-directory \"./etc/ps-print/\")"
+
+all:: auto-autoloads.elc $(ELCS) custom-load.elc
+
+srckit: srckit-std
+
+binkit: binkit-common
+Contents:
+---------
+        
+ps-print.tar.gz has the following files:
+
+   ps-print-X-Y-Z/README			This file
+   ps-print-X-Y-Z/ps-print-20.new		News for Emacs 20
+   ps-print-X-Y-Z/ps-print-21.new		News for Emacs 21
+
+   ps-print-X-Y-Z/lisp/ps-print/ps-bdf.el	BDF font file handler
+   ps-print-X-Y-Z/lisp/ps-print/ps-mule.el	multi-byte character facility
+   ps-print-X-Y-Z/lisp/ps-print/ps-print.el	main file
+   ps-print-X-Y-Z/lisp/ps-print/makefile	Makefile for byte-compiling
+						ps-print with Unix-like systems
+						(Unix or Win32 with cygwin)
+   ps-print-X-Y-Z/lisp/ps-print/make.bat	Batchfile to byte-compiling
+						ps-print with Win32-Systems
+
+   ps-print-X-Y-Z/etc/ps-print/ps-prin0.ps	prologue file 0
+   ps-print-X-Y-Z/etc/ps-print/ps-prin1.ps	prologue file 1
+
+Where X is the version number, Y is the release number and Z is the subrelease
+number.  The Z part is optional, so it's possible to exist ps-print-X-Y/.
+
+   
+Installation:
+-------------
+
+1. Add the lisp-subdirectory of your ps-print installation to your load-path.
+   You can do this in your .emacs or site-start.el with:
+
+   (add-to-list 'load-path "/your/path/to/ps-print/lisp")
+
+2. Go to the lisp subdirectory of ps-print:
+
+   cd ./ps-print/lisp/ps-print
+
+3. Type:  make.
+   On Unix or Cygwin-Environment, this will run the makefile file.
+   On Windows 9X/NT/2000 environment, this will call make.bat.
+   This will byte-compile all Emacs Lisp files (*.el files).
+
+4. Install the prologue files.
+
+   On GNU Emacs, the prologue files (ps-prin*.ps) should be installed in
+   directory given by `data-directory' variable which contains a string like
+   "/usr/share/emacs/20.3/etc/".
+
+   On XEmacs, the prologue files (ps-prin*.ps) should be installed in directory
+   given by `(locate-data-directory "ps-print")'.
+
+   If you wish to install prologue files in another directory, you should
+   customize `ps-postscript-code-directory' to contain the directory.  I
+   recommend this way.
+
+   One way to set `ps-postscript-code-directory' is to insert in your ~/.emacs:
+
+      (setq ps-postscript-code-directory "/directory/of/prologue/files/")
+      ;; (I recommend this way)
+
+   Or type:
+
+      M-x set-variable RET ps-postscript-code-directory RET
+      "/directory/of/prologue/files/" RET
+
+   Or type:
+
+      M-x ps-print-customize RET
+      and customize `ps-postscript-code-directory'.
+
+
+Happy hacking
+
+
+Vinicius
+http://www.cpqd.com.br/~vinicius/emacs/

etc/ps-print/ps-prin0.ps

+% === BEGIN ps-print prologue 0
+% 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.
+
+%%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

etc/ps-print/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
+
+/LineHS LineHeight LineSpacing add def
+/ParagraphHS LineHeight ParagraphSpacing add def
+/PSL{/h exch def bg{eolbg}if  0  currentpoint exch pop h sub  moveto}def
+/PLN{PrintLineNumber{doLineNumber}if}def
+
+/SL{LineHS PSL isLineStep pop}def	% Soft Linefeed
+
+/PHL{ParagraphHS PSL PLN}def		% Paragraph Hard Linefeed
+/LHL{LineHS 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
+/EffectUnderline false def
+/EffectStrikeout false def
+/EffectOverline  false def
+/EffectShadow    false def
+/EffectBox       false def
+/EffectOutline   false def
+
+% effect: 1  - underline  2   - strikeout  4  - overline
+%         8  - shadow     16  - box        32 - outline
+/EF{
+  /Effect exch def
+  /EffectUnderline Effect 1  and 0 ne def
+  /EffectStrikeout Effect 2  and 0 ne def
+  /EffectOverline  Effect 4  and 0 ne def
+  /EffectShadow    Effect 8  and 0 ne def
+  /EffectBox       Effect 16 and 0 ne def
+  /EffectOutline   Effect 32 and 0 ne def
+}def
+
+% stack:  string  |-  --
+/S{
+  /xx currentpoint dup Descent add/yy exch def
+  Ascent add/YY exch def def
+  dup stringwidth pop xx add/XX exch def
+  EffectShadow{
+    /yy yy Yshadow add def
+    /XX XX Xshadow add def
+  }if
+  bg{
+    true
+    EffectBox
+      {SpaceBackground doBox}
+      {xx yy XX YY doRect}
+    ifelse
+  }if						% background
+  EffectBox      {false 0 doBox}if		% box
+  EffectShadow   {dup doShadow}if		% shadow
+  EffectOutline
+    {true doOutline}				% outline
+    {show}					% normal text
+  ifelse
+  EffectUnderline{UnderlinePosition Hline}if	% underline
+  EffectStrikeout{StrikeoutPosition Hline}if	% strikeout
+  EffectOverline {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
+    LineNumberColor SetColor
+    /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 LineHS 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
+    LineHS mul neg 0 exch rmoveto
+    /zebra-line zebra-line LinesPerColumn add def
+  }if
+  /zspacing 0 def
+  lpc dup double-zebra idiv{ZebraHeight doZebra 0 yiter rmoveto}repeat
+  double-zebra mod dup 0 le{pop}
+  {dup ZebraHeight gt
+   {pop ZebraHeight}
+   {/zspacing LineSpacing def
+    ZebraFollow 2 and 0 ne{pop ZebraHeight}if}ifelse
+   doZebra}ifelse
+  grestore
+}def
+
+% stack:  zebra-height (in lines) |- --
+/doZebra{
+  /zh exch 0.05 sub LineHS mul zspacing sub 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
+  PrintOnlyOneHeader{ColumnIndex 1 eq}{true}ifelse
+  dup PrintHeader and{
+    PrintHeaderFrame{HeaderFrame}if
+    HeaderText
+  }if
+  PrintFooter and{
+    PrintFooterFrame{FooterFrame}if
+    FooterText
+  }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
+
+/TextStart{
+  LeftMargin BottomMargin
+  PrintFooter{
+    FooterPad add
+    FooterLines FooterLineHeight mul add
+    FooterPad add
+    FooterOffset add}if
+}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
+  TextStart translate
+
+  % ---- N-up printing
+  N-Up 1 gt N-Up-Border and pages-per-sheet 0 gt and{
+    % ---- page border
+    gsave
+    0 setgray
+    TextStart exch neg exch 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
+
+/SetFooterLines{			% nb-lines --
+  /FooterLines exch def
+  % ---- bottom up
+  FooterPad
+  FooterLines FooterLineHeight mul add
+  FooterPad add
+  /FooterHeight exch def
+}def
+
+% |---------|
+% |  tm     |
+% |---------|
+% |  header |
+% |-+-------| <-- (x y)
+% |  ho     |
+% |---------|
+% |  text   |
+% |---------|
+% |  fo     |
+% |---------|
+% |  footer |
+% |-+-------| <-- (0 0)
+% |  bm     |
+% |---------|
+
+% -- |- x y
+/HeaderFrameStart{0  PrintHeight HeaderOffset add}def
+/FooterFrameStart{0  FooterHeight FooterOffset add neg}def
+
+/doFramePath{
+  /h exch def
+  PrintHeaderWidth	0	rlineto
+  0			h	rlineto
+  PrintHeaderWidth neg	0	rlineto
+  0			h neg	rlineto
+}def
+
+/HeaderFramePath{HeaderHeight doFramePath}def
+/FooterFramePath{FooterHeight doFramePath}def
+
+% /path-fun /start-fun vector-property doFrame
+/doFrame{
+  /vecFrame exch def
+  /startFrame exch load def
+  /pathFrame exch load def
+  gsave
+    vecFrame 2 get setlinewidth				% frame border width
+    % ---- do the shadow of the next rectangle
+    startFrame moveto
+    1 -1 rmoveto
+    pathFrame
+    vecFrame 4 get SetColor fill			% frame shadow color
+    % ---- do the next rectangle ...
+    startFrame moveto
+    pathFrame
+    gsave vecFrame 1 get SetColor fill grestore		% frame background
+    gsave vecFrame 3 get SetColor stroke grestore	% frame border color
+  grestore
+}def
+
+/HeaderFrame{/HeaderFramePath /HeaderFrameStart HeaderFrameProperties doFrame}def
+/FooterFrame{/FooterFramePath /FooterFrameStart FooterFrameProperties doFrame}def
+
+/HeaderStart{
+  HeaderFrameStart
+  exch HeaderPad add exch	% horizontal pad
+  % ---- bottom up
+  HeaderPad add			% vertical   pad
+  HeaderDescent sub
+  HeaderLineHeight HeaderLines 1 sub mul add
+}def
+
+/FooterStart{
+  FooterFrameStart
+  exch FooterPad add exch	% horizontal pad
+  % ---- bottom up
+  FooterPad add			% vertical   pad
+  FooterDescent sub
+  FooterLineHeight FooterLines 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
+
+% lines is-right HeaderOrFooterTextLines
+/HeaderOrFooterTextLines{
+  /is_right exch def
+  HFStart moveto
+  { % ---- process the lines
+   aload pop
+   exch F
+   gsave
+    dup xcheck{exec}if
+    is_right{
+     dup stringwidth pop
+     PrintHeaderWidth exch sub HFPad HFPad add sub 0 rmoveto
+    }if
+    HFColor SetColor
+    show
+   grestore
+   0 HFLineHeight neg rmoveto
+  }forall
+}def
+
+% right-lines left-lines /start lineheight pad fore-color HeaderOrFooterText
+/HeaderOrFooterText{
+  /HFColor exch def
+  /HFPad exch def
+  /HFLineHeight exch def
+  /HFStart exch load def
+
+  % -- rightLines leftLines -- at stack
+
+  % ---- 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
+  false HeaderOrFooterTextLines
+
+  % ---- process the right lines
+  true HeaderOrFooterTextLines
+}def
+
+/HeaderText{
+  HeaderLinesRight HeaderLinesLeft
+  /HeaderStart HeaderLineHeight HeaderPad
+  HeaderFrameProperties 0 get
+  HeaderOrFooterText
+}def
+
+/FooterText{
+  FooterLinesRight FooterLinesLeft
+  /FooterStart FooterLineHeight FooterPad
+  FooterFrameProperties 0 get
+  HeaderOrFooterText
+}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
+;;; lpr.el --- print Emacs buffer on line printer.
+
+;; Copyright (C) 1985, 1988, 1992, 1994, 2000 Free Software Foundation, Inc.
+
+;; Maintainer:	FSF
+;; Keywords:	unix
+
+;; Modified by:	Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;;		(Tentative to have a `lpr' package that runs on GNU Emacs and
+;;		XEmacs).
+;; Time-stamp:	<2000/11/17 11:48:35 vinicius>
+;; Version:	1.2
+;; X-URL:	http://www.cpqd.com.br/~vinicius/emacs/
+
+;; 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.
+
+;;; Commentary:
+
+;; Commands to send the region or a buffer your printer.  Entry points
+;; are `lpr-buffer', `print-buffer', lpr-region', or `print-region'; option
+;; variables include `printer-name', `lpr-switches' and `lpr-command'.
+
+;;; Code:
+
+;;;###autoload
+(defvar lpr-windows-system
+  (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
+
+;;;###autoload
+(defvar lpr-lp-system
+  (memq system-type '(usg-unix-v dgux hpux irix)))
+
+
+(defgroup lpr nil
+  "Print Emacs buffer on line printer"
+  :group 'wp)
+
+
+;;;###autoload
+(defcustom printer-name
+  (and lpr-windows-system "PRN")
+  "*The name of a local printer to which data is sent for printing.
+\(Note that PostScript files are sent to `ps-printer-name', which see.\)
+
+On Unix-like systems, a string value should be a name understood by
+lpr's -P option; otherwise the value should be nil.
+
+On MS-DOS and MS-Windows systems, a string value is taken as the name of
+a printer device or port, provided `lpr-command' is set to \"\".
+Typical non-default settings would be \"LPT1\" to \"LPT3\" for parallel
+printers, or \"COM1\" to \"COM4\" or \"AUX\" for serial printers, or
+\"//hostname/printer\" for a shared network printer.  You can also set
+it to the name of a file, in which case the output gets appended to that
+file.  If you want to discard the printed output, set this to \"NUL\"."
+  :type '(choice :menu-tag "Printer Name"
+		 :tag "Printer Name"
+		 (const :tag "Default" nil)
+		 ;; could use string but then we lose completion for files.
+		 (file :tag "Name"))
+  :group 'lpr)
+
+;;;###autoload
+(defcustom lpr-switches nil
+  "*List of strings to pass as extra options for the printer program.
+It is recommended to set `printer-name' instead of including an explicit
+switch on this list.
+See `lpr-command'."
+  :type '(repeat (string :tag "Argument"))
+  :group 'lpr)
+
+(defcustom lpr-add-switches (eq system-type 'berkeley-unix)
+  "*Non-nil means construct -T and -J options for the printer program.
+These are made assuming that the program is `lpr';
+if you are using some other incompatible printer program,
+this variable should be nil."
+  :type 'boolean
+  :group 'lpr)
+
+(defcustom lpr-printer-switch
+  (if lpr-lp-system
+      "-d "
+    "-P")
+  "*Printer switch, that is, something like \"-P\", \"-d \", \"/D:\", etc.
+This switch is used in conjunction with `printer-name'."
+  :type '(choice :menu-tag "Printer Name Switch"
+		 :tag "Printer Name Switch"
+		 (const :tag "None" nil)
+		 (string :tag "Printer Switch"))
+  :group 'lpr)
+
+;;;###autoload
+(defcustom lpr-command
+  (cond
+   (lpr-windows-system
+    "")
+   (lpr-lp-system
+    "lp")
+   (t
+    "lpr"))
+  "*Name of program for printing a file.
+
+On MS-DOS and MS-Windows systems, if the value is an empty string then
+Emacs will write directly to the printer port named by `printer-name'.
+The programs `print' and `nprint' (the standard print programs on
+Windows NT and Novell Netware respectively) are handled specially, using
+`printer-name' as the destination for output; any other program is
+treated like `lpr' except that an explicit filename is given as the last
+argument."
+  :type 'string
+  :group 'lpr)
+
+;; Default is nil, because that enables us to use pr -f
+;; which is more reliable than pr with no args, which is what lpr -p does.
+(defcustom lpr-headers-switches nil
+  "*List of strings of options to request page headings in the printer program.
+If nil, we run `lpr-page-header-program' to make page headings
+and print the result."
+  :type '(repeat (string :tag "Argument"))
+  :group 'lpr)
+
+(defcustom print-region-function nil
+  "Function to call to print the region on a printer.
+See definition of `print-region-1' for calling conventions."
+  :type 'function
+  :group 'lpr)
+
+(defcustom lpr-page-header-program "pr"
+  "*Name of program for adding page headers to a file."
+  :type 'string
+  :group 'lpr)
+
+;; Berkeley systems support -F, and GNU pr supports both -f and -F,
+;; So it looks like -F is a better default.
+(defcustom lpr-page-header-switches '("-h" "-F")
+  "*List of strings to use as options for the page-header-generating program.
+The variable `lpr-page-header-program' specifies the program to use."
+  :type '(repeat string)
+  :group 'lpr)
+
+;;;###autoload
+(defun lpr-buffer ()
+  "Print buffer contents without pagination or page headers.
+See the variables `lpr-switches' and `lpr-command'
+for customization of the printer command."
+  (interactive)
+  (print-region-1 (point-min) (point-max) lpr-switches nil))
+
+;;;###autoload
+(defun print-buffer ()
+  "Paginate and print buffer contents.
+
+The variable `lpr-headers-switches' controls how to paginate.
+If it is nil (the default), we run the `pr' program (or whatever program
+`lpr-page-header-program' specifies) to paginate.
+`lpr-page-header-switches' specifies the switches for that program.
+
+Otherwise, the switches in `lpr-headers-switches' are used
+in the print command itself; we expect them to request pagination.
+ 
+See the variables `lpr-switches' and `lpr-command'
+for further customization of the printer command."
+  (interactive)
+  (print-region-1 (point-min) (point-max) lpr-switches t))
+
+;;;###autoload
+(defun lpr-region (start end)
+  "Print region contents without pagination or page headers.
+See the variables `lpr-switches' and `lpr-command'
+for customization of the printer command."
+  (interactive "r")
+  (print-region-1 start end lpr-switches nil))
+
+;;;###autoload
+(defun print-region (start end)
+  "Paginate and print the region contents.
+
+The variable `lpr-headers-switches' controls how to paginate.
+If it is nil (the default), we run the `pr' program (or whatever program
+`lpr-page-header-program' specifies) to paginate.
+`lpr-page-header-switches' specifies the switches for that program.
+
+Otherwise, the switches in `lpr-headers-switches' are used
+in the print command itself; we expect them to request pagination.
+ 
+See the variables `lpr-switches' and `lpr-command'
+for further customization of the printer command."
+  (interactive "r")
+  (print-region-1 start end lpr-switches t))
+
+(defun print-region-1 (start end switches page-headers)
+  ;; On some MIPS system, having a space in the job name
+  ;; crashes the printer demon.  But using dashes looks ugly
+  ;; and it seems to annoying to do for that MIPS system.
+  (let ((name  (concat (buffer-name) " Emacs buffer"))
+	(title (concat (buffer-name) " Emacs buffer"))
+	;; Make pipes use the same coding system as
+	;; writing the buffer to a file would.
+	(coding-system-for-write (or coding-system-for-write
+				     buffer-file-coding-system))
+	(coding-system-for-read  (or coding-system-for-read
+				     buffer-file-coding-system))
+	(width tab-width)
+	nswitches
+	switch-string)
+    (save-excursion
+      (and page-headers lpr-headers-switches
+	   ;; It's possible to use an lpr option to get page headers.
+	   (setq switches (append (if (stringp lpr-headers-switches)
+				      (list lpr-headers-switches)
+				    lpr-headers-switches)
+				  switches)))
+      (setq nswitches     (lpr-flatten-list
+			   (mapcar 'lpr-eval-switch ; Dynamic evaluation
+				   switches))
+	    switch-string (if switches
+			      (concat " with options "
+				      (mapconcat 'identity switches " "))
+			    ""))
+      (message "Spooling%s..." switch-string)
+      (if (/= tab-width 8)
+	  (let ((new-coords (print-region-new-buffer start end)))
+	    (setq start     (car new-coords)
+		  end       (cdr new-coords)
+		  tab-width width)
+	    (save-excursion
+	      (goto-char end)
+	      (setq end (point-marker)))
+	    (untabify (point-min) (point-max))))
+      (if page-headers
+	  (if lpr-headers-switches
+	      ;; We handled this above by modifying SWITCHES.
+	      nil
+	    ;; Run a separate program to get page headers.
+	    (let ((new-coords (print-region-new-buffer start end)))
+	      (apply 'call-process-region (car new-coords) (cdr new-coords)
+		     lpr-page-header-program t t nil
+		     lpr-page-header-switches))
+	    (setq start (point-min)
+		  end   (point-max))))
+      (apply (or print-region-function 'call-process-region)
+	     (nconc (list start end lpr-command
+			  nil nil nil)
+		    (and lpr-add-switches
+			 (list "-J" name))
+		    ;; These belong in pr if we are using that.
+		    (and lpr-add-switches lpr-headers-switches
+			 (list "-T" title))
+		    (and (stringp printer-name)
+			 (list (concat lpr-printer-switch
+				       printer-name)))
+		    nswitches))
+      (if (markerp end)
+	  (set-marker end nil))
+      (message "Spooling%s...done" switch-string))))
+
+;; This function copies the text between start and end
+;; into a new buffer, makes that buffer current.
+;; It returns the new range to print from the new current buffer
+;; as (START . END).
+
+(defun print-region-new-buffer (ostart oend)
+  (if (string= (buffer-name) " *spool temp*")
+      (cons ostart oend)
+    (let ((oldbuf (current-buffer)))
+      (set-buffer (get-buffer-create " *spool temp*"))
+      (widen)
+      (erase-buffer)
+      (insert-buffer-substring oldbuf ostart oend)
+      (cons (point-min) (point-max)))))
+
+(defun printify-region (begin end)
+  "Replace nonprinting characters in region with printable representations.
+The printable representations use ^ (for ASCII control characters) or hex.
+The characters tab, linefeed, space, return and formfeed are not affected."
+  (interactive "r")
+  (save-excursion
+    (goto-char begin)
+    (let (c)
+      (while (re-search-forward "[\^@-\^h\^k\^n-\^_\177-\377]" end t)
+	(setq c (preceding-char))
+	(delete-backward-char 1)
+	(insert (if (< c ?\ )
+		    (format "\\^%c" (+ c ?@))
+		  (format "\\%02x" c)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions hacked from `ps-print' package.
+
+;; Dynamic evaluation
+(defun lpr-eval-switch (arg)
+  (cond ((stringp arg) arg)
+	((functionp arg) (apply arg nil))
+	((symbolp arg) (symbol-value arg))
+	((consp arg) (apply (car arg) (cdr arg)))
+	(t nil)))
+
+;; `lpr-flatten-list' is defined here (copied from "message.el" and
+;; enhanced to handle dotted pairs as well) until we can get some
+;; sensible autoloads, or `flatten-list' gets put somewhere decent.
+
+;; (lpr-flatten-list '((a . b) c (d . e) (f g h) i . j))
+;; => (a b c d e f g h i j)
+
+(defun lpr-flatten-list (&rest list)
+  (lpr-flatten-list-1 list))
+
+(defun lpr-flatten-list-1 (list)
+  (cond
+   ((null list) (list))
+   ((consp list)
+    (append (lpr-flatten-list-1 (car list))
+	    (lpr-flatten-list-1 (cdr list))))
+   (t (list list))))
+
+(provide 'lpr)
+
+;;; lpr.el ends here
+(ps-print-nomule
+  (standards-version 1.1
+   version VERSION
+   author-version AUTHOR_VERSION
+   date DATE
+   build-date BUILD_DATE
+   maintainer MAINTAINER
+   distribution xemacs
+   priority medium
+   category CATEGORY
+   dump nil
+   description "Printing functions and utilities"
+   filename FILENAME
+   md5sum MD5SUM
+   size SIZE
+   provides (lpr ps-bdf ps-mule ps-print)
+   requires (REQUIRES)
+   type regular
+))
+;;; ps-bdf.el --- BDF font file handler for ps-print.
+
+;; Copyright (C) 1998, 1999, 2001 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+
+;; Keywords: wp, BDF, font, PostScript
+;; Maintainer:	Kenichi Handa <handa@etl.go.jp>
+;; Time-stamp:	<2001/09/19 13:15:38 vinicius>
+
+;; 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.
+
+;;; Commentary:
+
+;; Functions for getting bitmap information from X's BDF font file are
+;; provided.
+
+;;; Code:
+
+(eval-and-compile
+  (require 'ps-mule)
+
+  ;; to avoid XEmacs compilation gripes
+  (defvar installation-directory nil)
+  (defvar coding-system-for-read nil))
+
+;;;###autoload
+(defvar bdf-directory-list
+  (if (eq system-type 'ms-dos)
+      (list (expand-file-name "fonts/bdf" installation-directory))
+    '("/usr/local/share/emacs/fonts/bdf"))
+  "*List of directories to search for `BDF' font files.
+The default value is '(\"/usr/local/share/emacs/fonts/bdf\").")
+
+;; MS-DOS users like to move the binary around after it's built, but
+;; the value above is computed at load-up time.
+(and (eq system-type 'ms-dos)
+     (setq bdf-directory-list
+	   (list (expand-file-name "fonts/bdf" installation-directory))))
+
+(defun bdf-expand-file-name (bdfname)
+  "Return an absolute path name of a `BDF' font file BDFNAME.
+It searches directories listed in the variable `bdf-directory-list'
+for BDFNAME."
+  (if (file-name-absolute-p bdfname)
+      (and (file-readable-p bdfname)
+	   bdfname)
+    (let ((dir-list bdf-directory-list)
+	  dir)
+      (while (and dir-list
+		  (progn
+		    (setq dir (expand-file-name bdfname (car dir-list)))
+		    (not (file-readable-p dir))))
+	(setq dir nil
+	      dir-list (cdr dir-list)))
+      dir)))
+
+(defsubst bdf-file-mod-time (filename)
+  "Return modification time of FILENAME.
+The value is a list of two integers, the first integer has high-order
+16 bits, the second has low 16 bits."
+  (nth 5 (file-attributes filename)))
+
+(defun bdf-file-newer-than-time (filename mod-time)
+  "Return non-nil if and only if FILENAME is newer than MOD-TIME.
+MOD-TIME is a modification time as a list of two integers, the first
+integer has high-order 16 bits, the second has low 16 bits."
+  (let ((file-name (bdf-expand-file-name filename)))
+    (and file-name
+	 (let* ((new-mod-time (bdf-file-mod-time file-name))
+		(new-time (car new-mod-time))
+		(time (car mod-time)))
+	   (or (> new-time time)
+	       (and (= new-time time)
+		    (> (nth 1 new-mod-time) (nth 1 mod-time))))))))
+
+(defun bdf-find-file (bdfname)
+  "Return a buffer visiting a bdf file BDFNAME.
+If BDFNAME is not an absolute path, directories listed in
+`bdf-directory-list' is searched.
+If BDFNAME doesn't exist, return nil."
+  (let ((file-name (bdf-expand-file-name bdfname)))
+    (and file-name
+	 (let ((buf (generate-new-buffer " *bdf-work*"))
+	       (coding-system-for-read 'no-conversion))
+	   (save-excursion
+	     (set-buffer buf)
+	     (insert-file-contents file-name)
+	     buf)))))
+
+(defvar bdf-cache-file (convert-standard-filename "~/.bdfcache.el")
+  "Name of cache file which contains information of `BDF' font files.")
+
+(defvar bdf-cache nil
+  "Cached information of `BDF' font files.  It is a list of FONT-INFO.
+FONT-INFO is a list of the following format:
+    (BDFFILE ABSOLUTE-PATH MOD-TIME SIZE FONT-BOUNDING-BOX
+     RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
+See the documentation of the function `bdf-read-font-info' for more detail.")
+
+(defun bdf-read-cache ()
+  "Return a cached information about `BDF' font files from a cache file.
+The variable `bdf-cache-file' holds the cache file name.
+If the cache file is not readable, this return nil."
+  (setq bdf-cache nil)
+  (condition-case nil
+      (and (file-readable-p bdf-cache-file)
+	   (progn
+	     (load-file bdf-cache-file)
+	     (if (listp bdf-cache)
+		 bdf-cache
+	       (setq bdf-cache nil))))
+    (error nil)))
+
+(defun bdf-write-cache ()
+  "Write out cached information of `BDF' font file to a file.
+The variable `bdf-cache-file' holds the cache file name.
+The file is written if and only if the file already exists and writable."
+  (and bdf-cache
+       (file-exists-p bdf-cache-file)
+       (file-writable-p bdf-cache-file)
+       (write-region (format "(setq bdf-cache '%S)\n" bdf-cache)
+		     nil bdf-cache-file)))
+
+(defun bdf-set-cache (font-info)
+  "Cache FONT-INFO as information about one `BDF' font file.
+FONT-INFO is a list of the following format:
+    (BDFFILE ABSOLUTE-PATH MOD-TIME SIZE FONT-BOUNDING-BOX
+     RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
+See the documentation of the function `bdf-read-font-info' for more detail."
+  (let ((slot (assoc (car font-info) bdf-cache)))
+    (if slot
+	(setcdr slot (cdr font-info))
+      (setq bdf-cache (cons font-info bdf-cache)))))
+
+(defun bdf-initialize ()
+  "Initialize `bdf' library."
+  (and (bdf-read-cache)
+       (add-hook 'kill-emacs-hook 'bdf-write-cache)))
+
+(defun bdf-compact-code (code code-range)
+  (if (or (< code (aref code-range 4))
+	  (> code (aref code-range 5)))
+      (setq code (aref code-range 6)))
+  (+ (* (- (lsh code -8) (aref code-range 0))
+	(1+ (- (aref code-range 3) (aref code-range 2))))
+     (- (logand code 255) (aref code-range 2))))
+
+(defun bdf-expand-code (code code-range)
+  (let ((code0-range (1+ (- (aref code-range 3) (aref code-range 2)))))
+    (+ (* (+ (/ code code0-range) (aref code-range 0)) 256)
+       (+ (% code code0-range) (aref code-range 2)))))
+
+(defun bdf-search-and-read (match limit)
+  (goto-char (point-min))
+  (and (search-forward match limit t)
+       (progn
+	 (goto-char (match-end 0))
+	 (read (current-buffer)))))
+
+(defun bdf-read-font-info (bdfname)
+  "Read `BDF' font file BDFNAME and return information (FONT-INFO) of the file.
+FONT-INFO is a list of the following format:
+    (BDFFILE ABSOLUTE-PATH MOD-TIME FONT-BOUNDING-BOX
+     RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
+
+BDFFILE is a name of a font file (excluding directory part).
+
+ABSOLUTE-PATH is an absolute path of the font file.
+
+MOD-TIME is last modification time as a list of two integers, the
+first integer has high-order 16 bits, the second has low 16 bits.
+
+SIZE is a size of the font.  This value is got from SIZE record of the
+font.
+
+FONT-BOUNDING-BOX is the font bounding box as a list of four integers,
+BBX-WIDTH, BBX-HEIGHT, BBX-XOFF, and BBX-YOFF.
+
+RELATIVE-COMPOSE is an integer value of the font's property
+`_MULE_RELATIVE_COMPOSE'.  If the font doesn't have this property, the
+value is 0.
+
+BASELINE-OFFSET is an integer value of the font's property
+`_MULE_BASELINE_OFFSET'.  If the font doesn't have this property, the
+value is 0.
+
+CODE-RANGE is a vector of minimum 1st byte, maximum 1st byte, minimum
+2nd byte, maximum 2nd byte, minimum code, maximum code, and default
+code.  For 1-byte fonts, the first two elements are 0.
+
+MAXLEN is a maximum bytes of one glyph information in the font file.
+
+OFFSET-VECTOR is a vector of a file position which starts bitmap data
+of the glyph in the font file.
+
+Nth element of OFFSET-VECTOR is a file position for the glyph of code
+CODE, where N and CODE are in the following relation:
+    (bdf-compact-code CODE) => N, (bdf-expand-code N) => CODE"
+  (let* ((absolute-path (bdf-expand-file-name bdfname))
+	 (buf (and absolute-path (bdf-find-file absolute-path)))
+	 (maxlen 0)
+	 (relative-compose 'false)
+	 (baseline-offset 0)
+	 size
+	 font-bounding-box 
+	 default-char
+	 code-range
+	 offset-vector)
+    (if buf
+	(message "Reading %s..." bdfname)
+      (error "BDF file %s doesn't exist" bdfname))
+    (unwind-protect
+	(save-excursion
+	  (set-buffer buf)
+	  (goto-char (point-min))
+	  (search-forward "\nFONTBOUNDINGBOX")
+	  (setq font-bounding-box
+		(vector (read (current-buffer)) (read (current-buffer))
+			(read (current-buffer)) (read (current-buffer))))
+	  ;; The following kludgy code is to avoid bugs of fonts
+	  ;; jiskan16.bdf and jiskan24.bdf distributed with X.
+	  ;; They contain wrong FONTBOUNDINGBOX.
+	  (and (> (aref font-bounding-box 3) 0)
+	       (string-match "jiskan\\(16\\|24\\)" bdfname)
+	       (aset font-bounding-box 3
+		     (- (aref font-bounding-box 3))))
+
+	  (goto-char (point-min))
+	  (search-forward "\nSIZE ")
+	  (setq size (read (current-buffer)))
+	  ;; The following kludgy code is t avoid bugs of several
+	  ;; fonts which have wrong SIZE record.
+	  (and (<= size (/ (aref font-bounding-box 1) 3))
+	       (setq size (aref font-bounding-box 1)))
+
+	  (setq default-char (bdf-search-and-read "\nDEFAULT_CHAR" nil))
+
+	  (search-forward "\nSTARTCHAR")
+	  (forward-line -1)
+	  (let ((limit (point)))
+	    (setq relative-compose
+		  (or (bdf-search-and-read "\n_MULE_RELATIVE_COMPOSE" limit)
+		      'false)
+		  baseline-offset
+		  (or (bdf-search-and-read "\n_MULE_BASELINE_OFFSET" limit)
+		      0)))
+
+	  (let ((min-code0 256) (min-code1 256) (min-code 65536)
+		(max-code0 0) (max-code1 0) (max-code 0)
+		glyph glyph-list code0 code1 code offset)
+
+	    (while (search-forward "\nSTARTCHAR" nil t)
+	      (setq offset (line-beginning-position))
+	      (search-forward "\nENCODING")
+	      (setq code (read (current-buffer))
+		    code0 (lsh code -8)
+		    code1 (logand code 255)
+		    min-code (min min-code code)
+		    max-code (max max-code code)
+		    min-code0 (min min-code0 code0)
+		    max-code0 (max max-code0 code0)
+		    min-code1 (min min-code1 code1)
+		    max-code1 (max max-code1 code1))
+	      (search-forward "ENDCHAR")
+	      (setq maxlen (max maxlen (- (point) offset))
+		    glyph-list (cons (cons code offset) glyph-list)))
+
+	    (setq code-range
+		  (vector min-code0 max-code0 min-code1 max-code1
+			  min-code max-code (or default-char min-code))
+		  offset-vector
+		  (make-vector (1+ (bdf-compact-code max-code code-range))
+			       nil))
+
+	    (while glyph-list
+	      (setq glyph (car glyph-list)
+		    glyph-list (cdr glyph-list))
+	      (aset offset-vector
+		    (bdf-compact-code (car glyph) code-range)
+		    (cdr glyph)))))
+
+    (kill-buffer buf))
+  (message "Reading %s...done" bdfname)
+  (list bdfname absolute-path (bdf-file-mod-time absolute-path)
+	size font-bounding-box relative-compose baseline-offset
+	code-range maxlen offset-vector)))
+
+(defsubst bdf-info-absolute-path (font-info)     (nth 1 font-info))
+(defsubst bdf-info-mod-time (font-info)          (nth 2 font-info))
+(defsubst bdf-info-size (font-info)              (nth 3 font-info))
+(defsubst bdf-info-font-bounding-box (font-info) (nth 4 font-info))
+(defsubst bdf-info-relative-compose (font-info)  (nth 5 font-info))
+(defsubst bdf-info-baseline-offset (font-info)   (nth 6 font-info))
+(defsubst bdf-info-code-range (font-info)        (nth 7 font-info))
+(defsubst bdf-info-maxlen (font-info)            (nth 8 font-info))
+(defsubst bdf-info-offset-vector (font-info)     (nth 9 font-info))
+
+(defun bdf-get-font-info (bdfname)
+  "Return information about `BDF' font file BDFNAME.
+The value FONT-INFO is a list of the following format:
+    (BDFFILE ABSOLUTE-PATH MOD-TIME SIZE FONT-BOUNDING-BOX
+     RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
+See the documentation of the function `bdf-read-font-info' for more detail."
+  (or bdf-cache
+      (bdf-read-cache))
+  (let ((font-info (assoc bdfname bdf-cache)))
+    (if (or (not font-info)
+	    (not (file-readable-p (bdf-info-absolute-path font-info)))
+	    (bdf-file-newer-than-time bdfname (bdf-info-mod-time font-info)))
+	(progn
+	  (setq font-info (bdf-read-font-info bdfname))
+	  (bdf-set-cache font-info)))
+    font-info))
+
+(defun bdf-find-font-info (bdfnames)
+  "Return information about `BDF' font file with alternative names BDFNAMES.
+
+If BDFNAMES is a list of file names, this function finds the first file
+in the list which exists and is readable, then calls `bdf-get-font-info'
+on that file name."
+  (let ((fnlist bdfnames)
+	(fname bdfnames))
+    (if (consp fnlist)
+	(while (and fnlist
+		    (progn
+		      (setq fname (car fnlist))
+		      (null (bdf-expand-file-name fname))))
+	  (setq fname nil
+		fnlist (cdr fnlist))))
+    (bdf-get-font-info (or fname (car bdfnames)))))
+
+(defun bdf-read-bitmap (bdfname offset maxlen)
+  "Read `BDF' font file BDFNAME to get bitmap data at file position OFFSET.
+BDFNAME is an absolute path name of the font file.
+MAXLEN specifies how many bytes we should read at least.
+The value is a list of DWIDTH, BBX, and BITMAP-STRING.
+DWIDTH is a pixel width of a glyph.
+BBX is a bounding box of the glyph.
+BITMAP-STRING is a string representing bits by hexadecimal digits."
+  (let ((coding-system-for-read 'no-conversion)
+	dwidth bbx height yoff bitmap-string)
+    (condition-case nil
+	(with-temp-buffer
+	  (insert-file-contents bdfname nil offset (+ offset maxlen))
+	  (goto-char (point-min))
+	  (search-forward "\nDWIDTH")
+	  (setq dwidth (read (current-buffer)))
+	  (goto-char (point-min))
+	  (search-forward "\nBBX")
+	  (setq bbx (vector (read (current-buffer)) (read (current-buffer))
+			    (read (current-buffer)) (read (current-buffer)))
+		height (aref bbx 1)
+		yoff (aref bbx 3))
+	  (search-forward "\nBITMAP")
+	  (forward-line 1)
+	  (delete-region (point-min) (point))
+	  (and (looking-at "\\(0+\n\\)+")
+	       (progn
+		 (setq height (- height (count-lines (point) (match-end 0))))
+		 (delete-region (point) (match-end 0))))
+	  (or (looking-at "ENDCHAR")
+	      (progn
+		(search-forward "ENDCHAR" nil 'move)
+		(forward-line -1)
+		(while (looking-at "0+$")
+		  (setq yoff (1+ yoff)
+			height (1- height))
+		  (forward-line -1))
+		(forward-line 1)))
+	  (aset bbx 1 height)
+	  (aset bbx 3 yoff)
+	  (delete-region (point) (point-max))
+	  (goto-char (point-min))
+	  (while (not (eobp))
+	    (end-of-line)
+	    (delete-char 1))
+	  (setq bitmap-string (buffer-string)))
+      (error nil))
+    (list dwidth bbx bitmap-string)))
+
+(defun bdf-get-bitmaps (bdfname codes)
+  "Return bitmap information of glyphs of CODES in `BDF' font file BDFNAME.
+CODES is a list of encoding number of glyphs in the file.
+The value is a list of CODE, DWIDTH, BBX, and BITMAP-STRING.
+DWIDTH is a pixel width of a glyph.
+BBX is a bounding box of the glyph.
+BITMAP-STRING is a string representing bits by hexadecimal digits."
+  (let* ((font-info (bdf-find-font-info bdfname))
+	 (absolute-path (bdf-info-absolute-path font-info))
+	 ;;(font-bounding-box (bdf-info-font-bounding-box font-info))
+	 (maxlen (bdf-info-maxlen font-info))
+	 (code-range (bdf-info-code-range font-info))
+	 (offset-vector (bdf-info-offset-vector font-info)))
+    (mapcar '(lambda (x)
+	       (cons x (bdf-read-bitmap
+			absolute-path
+			(aref offset-vector (bdf-compact-code x code-range))
+			maxlen)))
+	    codes)))
+
+;;; Interface to ps-print.el
+
+;; Called from ps-mule-init-external-library.
+(defun bdf-generate-prologue ()
+  (or bdf-cache
+      (bdf-initialize))
+  (ps-mule-generate-bitmap-prologue))
+
+;; Called from ps-mule-generate-font.
+(defun bdf-generate-font (charset font-spec)
+  (let* ((font-name (ps-mule-font-spec-name font-spec))
+	 (font-info (bdf-find-font-info font-name))
+	 (font-name (if (consp font-name) (car font-name) font-name)))
+    (ps-mule-generate-bitmap-font font-name
+				  (ps-mule-font-spec-bytes font-spec)
+				  (charset-width charset)
+				  (bdf-info-size font-info)
+				  (bdf-info-relative-compose font-info)
+				  (bdf-info-baseline-offset font-info)
+				  (bdf-info-font-bounding-box font-info))))
+
+;; Called from ps-mule-generate-glyphs.
+(defun bdf-generate-glyphs (font-spec code-list bytes)
+  (let ((font-name (ps-mule-font-spec-name font-spec)))
+    (mapcar '(lambda (x)
+	       (apply 'ps-mule-generate-bitmap-glyph
+		      (if (consp font-name) (car font-name) font-name)
+		      x))
+	    (bdf-get-bitmaps font-name code-list))))
+
+(provide 'ps-bdf)
+
+;;; ps-bdf.el ends here
+;;; ps-mule.el --- provide multi-byte character facility to ps-print
+
+;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+
+;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;;	Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
+;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
+;;	Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; Keywords: wp, print, PostScript, multibyte, mule
+;; Time-stamp: <2001/08/15 15:34:11 vinicius>
+
+;; 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.
+
+;;; Commentary:
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; About ps-mule
+;; -------------
+;;
+;; This package is used for ps-print to print multi-byte buffer.
+;;
+;; See also ps-print.el.
+;;
+;;
+;; Printing Multi-byte Buffer
+;; --------------------------
+;;
+;; The variable `ps-multibyte-buffer' specifies the ps-print multi-byte buffer
+;; handling.
+;;
+;; Valid values for `ps-multibyte-buffer' are:
+;;
+;;  nil                     This is the value to use the default settings which
+;;			    is by default for printing buffer with only ASCII
+;;			    and Latin characters.   The default setting can be
+;;			    changed by setting the variable
+;;			    `ps-mule-font-info-database-default' differently.
+;;			    The initial value of this variable is
+;;			    `ps-mule-font-info-database-latin' (see
+;;			    documentation).
+;;
+;;  `non-latin-printer'     This is the value to use when you have a japanese
+;;			    or korean PostScript printer and want to print
+;;			    buffer with ASCII, Latin-1, Japanese (JISX0208 and
+;;			    JISX0201-Kana) and Korean characters.  At present,
+;;			    it was not tested the Korean characters printing.
+;;			    If you have a korean PostScript printer, please,
+;;			    test it.
+;;
+;;  `bdf-font'              This is the value to use when you want to print
+;;			    buffer with BDF fonts.  BDF fonts include both latin
+;;			    and non-latin fonts.  BDF (Bitmap Distribution
+;;			    Format) is a format used for distributing X's font
+;;			    source file.  BDF fonts are included in
+;;			    `intlfonts-1.2' which is a collection of X11 fonts
+;;			    for all characters supported by Emacs.  In order to
+;;			    use this value, be sure to have installed
+;;			    `intlfonts-1.2' and set the variable
+;;			    `bdf-directory-list' appropriately (see ps-bdf.el
+;;			    for documentation of this variable).
+;;
+;;  `bdf-font-except-latin' This is like `bdf-font' except that it is used
+;;			    PostScript default fonts to print ASCII and Latin-1
+;;			    characters.  This is convenient when you want or
+;;			    need to use both latin and non-latin characters on
+;;			    the same buffer.  See `ps-font-family',
+;;			    `ps-header-font-family' and `ps-font-info-database'.
+;;
+;; Any other value is treated as nil.
+;;
+;; The default is nil.
+;;
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Code:
+
+(eval-and-compile
+  (require 'ps-print)
+
+  ;; to avoid XEmacs compilation gripes
+  (defvar leading-code-private-22 157)
+  (or (fboundp 'charset-bytes)
+      (defun charset-bytes (charset) 1)) ; ascii
+  (or (fboundp 'charset-dimension)
+      (defun charset-dimension (charset) 1)) ; ascii
+  (or (fboundp 'charset-id)
+      (defun charset-id (charset) 0))	; ascii
+  (or (fboundp 'charset-width)
+      (defun charset-width (charset) 1)) ; ascii
+  (or (fboundp 'find-charset-region)
+      (defun find-charset-region (beg end &optional table)
+	(list 'ascii)))
+  (or (fboundp 'char-valid-p)
+      (defun char-valid-p (char)
+	(< (following-char) 256)))
+  (or (fboundp 'split-char)
+      (defun split-char (char)
+	(list (if (char-valid-p char)
+		  'ascii
+		'unknow)
+	      char)))
+  (or (fboundp 'char-width)
+      (defun char-width (char) 1))	; ascii
+  (or (fboundp 'chars-in-region)
+      (defun chars-in-region (beg end)
+	(- (max beg end) (min beg end))))
+  (or (fboundp 'forward-point)
+      (defun forward-point (arg)
+	(save-excursion
+	  (let ((count (abs arg))
+		(step  (if (zerop arg)
+			   0
+			 (/ arg arg))))
+	    (while (and (> count 0)
+			(< (point-min) (point)) (< (point) (point-max)))
+	      (forward-char step)
+	      (setq count (1- count)))
+	    (+ (point) (* count step))))))
+  (or (fboundp 'decompose-composite-char)
+      (defun decompose-composite-char (char &optional type
+					    with-composition-rule)
+	nil))
+  (or (fboundp 'encode-coding-string)
+      (defun encode-coding-string (string coding-system &optional nocopy)
+	(if nocopy
+	    string
+	  (copy-sequence string))))
+  (or (fboundp 'coding-system-p)
+      (defun coding-system-p (obj) nil))
+  (or (fboundp 'ccl-execute-on-string)
+      (defun ccl-execute-on-string (ccl-prog status str
+					     &optional contin unibyte-p)
+	str))
+  (or (fboundp 'define-ccl-program)
+      (defmacro define-ccl-program (name ccl-program &optional doc)
+	`(defconst ,name nil ,doc)))
+  (or (fboundp 'multibyte-string-p)
+      (defun multibyte-string-p (str)
+	(let ((len (length str))
+	      (i 0)
+	      multibyte)
+	  (while (and (< i len) (not (setq multibyte (> (aref str i) 255))))
+	    (setq i (1+ i)))
+	  multibyte)))
+  (or (fboundp 'string-make-multibyte)
+      (defalias 'string-make-multibyte 'copy-sequence)))
+
+
+;;;###autoload
+(defcustom ps-multibyte-buffer nil
+  "*Specifies the multi-byte buffer handling.
+
+Valid values are:
+
+  nil                     This is the value to use the default settings which
+			  is by default for printing buffer with only ASCII
+			  and Latin characters.   The default setting can be
+			  changed by setting the variable
+			  `ps-mule-font-info-database-default' differently.
+			  The initial value of this variable is
+			  `ps-mule-font-info-database-latin' (see
+			  documentation).
+
+  `non-latin-printer'     This is the value to use when you have a Japanese
+			  or Korean PostScript printer and want to print
+			  buffer with ASCII, Latin-1, Japanese (JISX0208 and
+			  JISX0201-Kana) and Korean characters.  At present,
+			  it was not tested the Korean characters printing.
+			  If you have a korean PostScript printer, please,
+			  test it.
+
+  `bdf-font'              This is the value to use when you want to print
+			  buffer with BDF fonts.  BDF fonts include both latin
+			  and non-latin fonts.  BDF (Bitmap Distribution
+			  Format) is a format used for distributing X's font
+			  source file.  BDF fonts are included in
+			  `intlfonts-1.2' which is a collection of X11 fonts
+			  for all characters supported by Emacs.  In order to
+			  use this value, be sure to have installed
+			  `intlfonts-1.2' and set the variable
+			  `bdf-directory-list' appropriately (see ps-bdf.el for
+			  documentation of this variable).
+
+  `bdf-font-except-latin' This is like `bdf-font' except that it is used
+			  PostScript default fonts to print ASCII and Latin-1
+			  characters.  This is convenient when you want or
+			  need to use both latin and non-latin characters on
+			  the same buffer.  See `ps-font-family',
+			  `ps-header-font-family' and `ps-font-info-database'.
+
+Any other value is treated as nil."
+  :type '(choice (const non-latin-printer)     (const bdf-font)
+		 (const bdf-font-except-latin) (const :tag "nil" nil))
+  :group 'ps-print-font)
+
+
+(eval-and-compile
+  ;; For Emacs 20.2 and the earlier version.
+  (if (and (boundp 'mule-version)
+	   (not (string< (symbol-value 'mule-version) "4.0")))
+      ;; mule package is loaded
+      (progn
+	(defalias 'ps-mule-next-point '1+)
+	(defalias 'ps-mule-chars-in-string 'length)
+	(defalias 'ps-mule-string-char 'aref)
+	(defsubst ps-mule-next-index (str i) (1+ i)))
+    ;; mule package isn't loaded or mule version lesser than 4.0
+    (defun ps-mule-next-point (arg)
+      (save-excursion (goto-char arg) (forward-char 1) (point)))
+    (defun ps-mule-chars-in-string (string)
+      (/ (length string)
+	 (charset-bytes (char-charset (string-to-char string)))))
+    (defun ps-mule-string-char (string idx)
+      (string-to-char (substring string idx)))
+    (defun ps-mule-next-index (string i)
+      (+ i (charset-bytes (char-charset (string-to-char string)))))
+    )
+  ;; For Emacs 20.4 and the earlier version.
+  (if (and (boundp 'mule-version)
+	   (string< (symbol-value 'mule-version) "5.0"))
+      ;; mule package is loaded and mule version is lesser than 5.0
+      (progn
+	(defun encode-composition-rule (rule)
+	  (if (= (car rule) 4) (setcar rule 10))
+	  (if (= (cdr rule) 4) (setcdr rule 10))
+	  (+ (* (car rule) 12) (cdr rule)))
+	(defun find-composition (pos &rest ignore)
+	  (let ((ch (char-after pos)))
+	    (and ch (eq (char-charset ch) 'composition)
+		 (let ((components (decompose-composite-char ch 'vector t)))
+		   (list pos (ps-mule-next-point pos) components
+			 (integerp (aref components 1)) nil
+			 (char-width ch)))))))
+    ;; mule package isn't loaded
+    (or (fboundp 'encode-composition-rule)
+	(defun encode-composition-rule (rule)
+	  130))
+    (or (fboundp 'find-composition)
+	(defun find-composition (pos &rest ignore)
+	  nil))
+    ))
+
+(defvar ps-mule-font-info-database
+  nil
+  "Alist of charsets with the corresponding font information.
+Each element has the form:
+
+	(CHARSET (FONT-TYPE FONT-SRC FONT-NAME ENCODING BYTES) ...)
+
+Where
+
+CHARSET is a charset (symbol) for this font family,
+
+FONT-TYPE is a font type: normal, bold, italic, or bold-italic.
+
+FONT-SRC is a font source: builtin, ps-bdf, vflib, or nil.
+
+  If FONT-SRC is builtin, FONT-NAME is a built-in PostScript font name.
+
+  If FONT-SRC is bdf, FONT-NAME is a BDF font file name, or a list of
+  alternative font names.  To use this font, the external library `ps-bdf'
+  is required.
+
+  If FONT-SRC is vflib, FONT-NAME is the name of a font that VFlib knows.
+  To use this font, the external library `vflib' is required.
+
+  If FONT-SRC is nil, a proper ASCII font in the variable
+  `ps-font-info-database' is used.  This is useful for Latin-1 characters.
+
+ENCODING is a coding system to encode a string of characters of CHARSET into a
+proper string matching an encoding of the specified font.  ENCODING may be a
+function that does this encoding.  In this case, the function is called with
+one argument, the string to encode, and it should return an encoded string.
+
+BYTES specifies how many bytes each character has in the encoded byte
+sequence; it should be 1 or 2.
+
+All multi-byte characters are printed by fonts specified in this database
+regardless of a font family of ASCII characters.  The exception is Latin-1
+characters which are printed by the same font as ASCII characters, thus obey
+font family.
+
+See also the variable `ps-font-info-database'.")
+
+(defconst ps-mule-font-info-database-latin
+  '((latin-iso8859-1
+     (normal nil nil iso-latin-1)))
+  "Sample setting of `ps-mule-font-info-database' to use latin fonts.")
+
+(defcustom ps-mule-font-info-database-default
+  ps-mule-font-info-database-latin
+  "*The default setting to use when `ps-multibyte-buffer' is nil."
+  :type '(symbol :tag "Multi-Byte Buffer Database Font Default")
+  :group 'ps-print-font)
+
+(defconst ps-mule-font-info-database-ps
+  '((katakana-jisx0201
+     (normal builtin "Ryumin-Light.Katakana" ps-mule-encode-7bit 1)
+     (bold builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1)
+     (bold-italic builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1))
+    (latin-jisx0201
+     (normal builtin "Ryumin-Light.Hankaku" ps-mule-encode-7bit 1)
+     (bold builtin "GothicBBB-Medium.Hankaku" ps-mule-encode-7bit 1))
+    (japanese-jisx0208
+     (normal builtin "Ryumin-Light-H" ps-mule-encode-7bit 2)
+     (bold builtin "GothicBBB-Medium-H" ps-mule-encode-7bit 2))
+    (korean-ksc5601
+     (normal builtin "Munhwa-Regular-KSC-EUC-H" ps-mule-encode-7bit 2)
+     (bold builtin "Munhwa-Bold-KSC-EUC-H" ps-mule-encode-7bit 2))
+    )
+  "Sample setting of the `ps-mule-font-info-database' to use builtin PS font.
+
+Currently, data for Japanese and Korean PostScript printers are listed.")
+
+(defconst ps-mule-font-info-database-bdf
+  '((ascii
+     (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") nil 1)
+     (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf") nil 1)
+     (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf") nil 1)
+     (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf") nil 1))
+    (latin-iso8859-1
+     (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") iso-latin-1 1)
+     (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf") iso-latin-1 1)
+     (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf") iso-latin-1 1)
+     (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf") iso-latin-1 1))
+    (latin-iso8859-2
+     (normal bdf ("lt2-24-etl.bdf" "etl24-latin2.bdf") iso-latin-2 1))
+    (latin-iso8859-3
+     (normal bdf ("lt3-24-etl.bdf" "etl24-latin3.bdf") iso-latin-3 1))
+    (latin-iso8859-4
+     (normal bdf ("lt4-24-etl.bdf" "etl24-latin4.bdf") iso-latin-4 1))
+    (thai-tis620
+     (normal bdf ("thai24.bdf" "thai-24.bdf") thai-tis620 1))
+    (greek-iso8859-7
+     (normal bdf ("grk24-etl.bdf" "etl24-greek.bdf") greek-iso-8bit 1))
+    ;; (arabic-iso8859-6	nil) ; not yet available
+    (hebrew-iso8859-8
+     (normal bdf ("heb24-etl.bdf" "etl24-hebrew.bdf") hebrew-iso-8bit 1))
+    (katakana-jisx0201
+     (normal bdf "12x24rk.bdf" ps-mule-encode-8bit 1))
+    (latin-jisx0201
+     (normal bdf "12x24rk.bdf" ps-mule-encode-7bit 1))
+    (cyrillic-iso8859-5
+     (normal bdf ("cyr24-etl.bdf" "etl24-cyrillic.bdf") cyrillic-iso-8bit 1))
+    (latin-iso8859-9
+     (normal bdf ("lt5-24-etl.bdf" "etl24-latin5.bdf") iso-latin-5 1))
+    (japanese-jisx0208-1978
+     (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2))
+    (chinese-gb2312
+     (normal bdf "gb24st.bdf" ps-mule-encode-7bit 2))
+    (japanese-jisx0208
+     (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2))
+    (korean-ksc5601
+     (normal bdf "hanglm24.bdf" ps-mule-encode-7bit 2))
+    (japanese-jisx0212
+     (normal bdf ("jksp40.bdf" "jisksp40.bdf") ps-mule-encode-7bit 2))
+    (chinese-cns11643-1
+     (normal bdf ("cns1-40.bdf" "cns-1-40.bdf") ps-mule-encode-7bit 2))
+    (chinese-cns11643-2
+     (normal bdf ("cns2-40.bdf" "cns-2-40.bdf") ps-mule-encode-7bit 2))
+    (chinese-big5-1
+     (normal bdf "taipei24.bdf" chinese-big5 2))
+    (chinese-big5-2
+     (normal bdf "taipei24.bdf" chinese-big5 2))
+    (chinese-sisheng