comparison lisp/ps-print.el @ 88155:d7ddb3e565de

sync with trunk

88154:8ce476d3ba36

;;; ps-print.el --- print text from the buffer as PostScript

;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
;; 2003 Free Software Foundation, Inc.

;; Author: Jim Thompson (was <[e-mail]>)
;;	Jacques Duthen (was <[e-mail]>)
;;	Vinicius Jose Latorre <[e-mail]>
;;	Kenichi Handa <[e-mail]> (multi-byte characters)
;; Maintainer: Kenichi Handa <[e-mail]> (multi-byte characters)
;;	Vinicius Jose Latorre <[e-mail]>
;; Keywords: wp, print, PostScript
;; Time-stamp: <2003/02/12 14:05:44 vinicius>
;; Version: 6.5.9
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/

(defconst ps-print-version "6.5.9"
  "ps-print.el, v 6.5.9 <2003/02/12 vinicius>

Vinicius's last change version -- this file may have been edited as part of
Emacs without changes to the version number.  When reporting bugs, please also
report the version of Emacs, if any, that ps-print was distributed with.

Please send all bug fixes and enhancements to
	Vinicius Jose Latorre <[e-mail]>.")

;; 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

;; 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:

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;

;;		20 XXXXX +   20 XXXXXXXX +   18 XXXXXX +   18               +
;;		21       +   21 XXXXXXXX +
;;		22       +   22          +
;;		--------     -----------     ---------     ----------------
;;
;; Any other value is treated as `nil'.
;;
;; See also section How Ps-Print Has A Text And/Or Image On Background.
;;
;;
;; Hooks

;;
;; You can create new `mixed' font families like:
;;      (my-mixed-family
;;       (fonts (normal               . "Courier-Bold")
;;              (bold                 . "Helvetica")
;;              (italic               . "Zapf-Chancery-MediumItalic")
;;              (bold-italic          . "NewCenturySchlbk-BoldItalic")
;;              (w3-table-hack-x-face . "LineDrawNormal"))
;;       (size . 10.0)
;;       (line-height . 10.55)
;;       (space-width . 6.0)

;;      (my-mixed-family
;;       (size . 10.0)
;;       (fonts (w3-table-hack-x-face . "LineDrawNormal")
;;              (bold                 . "Helvetica")
;;              (bold-italic          . "NewCenturySchlbk-BoldItalic")
;;              (italic               . "Zapf-Chancery-MediumItalic")
;;              (normal               . "Courier-Bold"))
;;       (avg-char-width . 6.0)
;;       (space-width . 6.0)
;;       (line-height . 10.55))
;;

;;    t		always use face background color.
;;    nil	never use face background color.
;;    (face...)	list of faces whose background color will be used.
;;
;; Any other value will be treated as t.
;; The default value is t.
;;
;;
;; How Ps-Print Deals With Color
;; -----------------------------
;;

;;
;;
;; New since version 2.8
;; ---------------------
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    20010619
;;	 `ps-time-stamp-locale-default'
;;
;;    20010530

;;
;;    19990513
;;	 N-up printing.
;;	 Hook: `ps-print-begin-sheet-hook'.
;;
;; [keinichi] 19990509 Kein'ichi Handa <[e-mail]>
;;
;; `ps-print-region-function'
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    19990301
;;	 PostScript tumble and setpagedevice.
;;
;;    19980922
;;	 PostScript prologue header comment insertion.
;;	 Skip invisible text better.
;;
;; [keinichi] 19980819 Kein'ichi Handa <[e-mail]>
;;
;; Multi-byte buffer handling.
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    19980306
;;	 Skip invisible text.
;;
;;    19971130

;;
;;
;; Acknowledgments
;; ---------------
;;
;; Thanks to Adam Doppelt <[e-mail]> for face mapping suggestion
;; for black/white PostScript printers.
;;
;; Thanks to Toni Ronkko <[e-mail]> for line and paragraph spacing,
;; region to cut out when printing and footer suggestions.

;; suggestion for `ps-postscript-code-directory' variable.
;;
;; Thanks to David X Callaway <[e-mail]> for helping debugging PostScript
;; level 1 compatibility.
;;
;; Thanks to Colin Marquardt <[e-mail]> for upside-down,
;; line number step, line number start and zebra stripe follow suggestions, and
;; for XEmacs beta-tests.
;;
;; Thanks to Klaus Berndl <[e-mail]> for user defined PostScript
;; prologue code suggestion, for odd/even printing suggestion and for
;; `ps-prologue-file' enhancement.
;;
;; Thanks to Kein'ichi Handa <[e-mail]> for multi-byte buffer handling.
;;
;; Thanks to Matthew O Persico <[e-mail]> for line number on
;; empty columns.
;;
;; Thanks to Theodore Jump <[e-mail]> for adjust PostScript code order on

;;
;; Thanks to Avishai Yacobi, [e-mail], for writing the
;; initial port to Emacs 19.  His code is no longer part of ps-print, but his
;; work is still appreciated.
;;
;; Thanks to Remi Houdaille and Michel Train, [e-mail], for
;; adding underline support.  Their code also is no longer part of ps-print,
;; but their efforts are not forgotten.
;;
;; Thanks also to all of you who mailed code to add features to ps-print;
;; although I didn't use your code, I still appreciate your sharing it with me.

;; Jim
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Code:

(eval-and-compile
  (require 'lpr)

  (or (featurep 'lisp-float-type)
      (error "`ps-print' requires floating point support"))


  (defvar ps-print-emacs-type
    (let ((case-fold-search t))
      (cond ((string-match "XEmacs" emacs-version) 'xemacs)
	    ((string-match "Lucid" emacs-version)
	     (error "`ps-print' doesn't support Lucid"))
	    ((string-match "Epoch" emacs-version)
	     (error "`ps-print' doesn't support Epoch"))
	    (t
	     (unless (and (boundp 'emacs-major-version)
			  (> emacs-major-version 19))
	       (error "`ps-print' only supports Emacs 20 and higher"))
	     'emacs))))


  ;; For Emacs 20.2 and the earlier version.

  (or (fboundp 'set-buffer-multibyte)
      (defun set-buffer-multibyte (arg)
	(setq enable-multibyte-characters arg)))

  (or (fboundp 'string-as-unibyte)
      (defun string-as-unibyte (arg) arg))

  (or (fboundp 'string-as-multibyte)
      (defun string-as-multibyte (arg) arg))

  (or (fboundp 'char-charset)
      (defun char-charset (arg) 'ascii))

  (or (fboundp 'charset-after)
      (defun charset-after (&optional arg)
	(char-charset (char-after arg))))


  ;; GNU Emacs
  (or (fboundp 'line-beginning-position)
      (defun line-beginning-position (&optional n)
	(save-excursion
	  (and n (/= n 1) (forward-line (1- n)))
	  (beginning-of-line)
	  (point))))


  ;; to avoid compilation gripes

  ;; XEmacs
  (defalias 'ps-x-color-instance-p              'color-instance-p)
  (defalias 'ps-x-color-instance-rgb-components 'color-instance-rgb-components)
  (defalias 'ps-x-color-name                    'color-name)
  (defalias 'ps-x-color-specifier-p             'color-specifier-p)
  (defalias 'ps-x-copy-coding-system            'copy-coding-system)
  (defalias 'ps-x-device-class                  'device-class)
  (defalias 'ps-x-extent-end-position           'extent-end-position)
  (defalias 'ps-x-extent-face                   'extent-face)
  (defalias 'ps-x-extent-priority               'extent-priority)
  (defalias 'ps-x-extent-start-position         'extent-start-position)
  (defalias 'ps-x-face-font-instance            'face-font-instance)
  (defalias 'ps-x-find-coding-system            'find-coding-system)
  (defalias 'ps-x-font-instance-properties      'font-instance-properties)
  (defalias 'ps-x-make-color-instance           'make-color-instance)
  (defalias 'ps-x-map-extents                   'map-extents)

  ;; GNU Emacs
  (defalias 'ps-e-face-bold-p         'face-bold-p)
  (defalias 'ps-e-face-italic-p       'face-italic-p)
  (defalias 'ps-e-next-overlay-change 'next-overlay-change)
  (defalias 'ps-e-overlays-at         'overlays-at)
  (defalias 'ps-e-overlay-get         'overlay-get)
  (defalias 'ps-e-overlay-end         'overlay-end)
  (defalias 'ps-e-x-color-values      'x-color-values)
  (defalias 'ps-e-color-values        'color-values)
  (if (fboundp 'find-composition)
      (defalias 'ps-e-find-composition 'find-composition)
    (defalias 'ps-e-find-composition 'ignore))


  (defconst ps-windows-system
    (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
  (defconst ps-lp-system
    (memq system-type '(usg-unix-v dgux hpux irix)))


  (defun ps-xemacs-color-name (color)
    (if (ps-x-color-specifier-p color)
	(ps-x-color-name color)
      color))


  (cond ((eq ps-print-emacs-type 'emacs) ; emacs
	 (defvar mark-active nil)
	 (defun ps-mark-active-p ()
	   mark-active)
	 (defalias 'ps-face-foreground-name 'face-foreground)
	 (defalias 'ps-face-background-name 'face-background)
	 )
	(t				; xemacs
	 (defalias 'ps-mark-active-p 'region-active-p)
	 (defun ps-face-foreground-name (face)
	   (ps-xemacs-color-name (face-foreground face)))
	 (defun ps-face-background-name (face)
	   (ps-xemacs-color-name (face-background face)))
	 )))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User Variables:


;;; Interface to the command system

(defgroup postscript nil
  "PostScript Group"
  :tag "PostScript"
  :group 'emacs)

(defgroup ps-print nil
  "PostScript generator for Emacs"
  :link '(emacs-library-link :tag "Source Lisp File" "ps-print.el")
  :prefix "ps-"
  :group 'wp
  :group 'postscript)

(defgroup ps-print-horizontal nil
  "Horizontal page layout"
  :prefix "ps-"
  :tag "Horizontal"
  :group 'ps-print)

(defgroup ps-print-vertical nil
  "Vertical page layout"
  :prefix "ps-"
  :tag "Vertical"
  :group 'ps-print)

(defgroup ps-print-headers nil
  "Headers & footers layout"
  :prefix "ps-"
  :tag "Header & Footer"
  :group 'ps-print)

(defgroup ps-print-font nil
  "Fonts customization"
  :prefix "ps-"
  :tag "Font"
  :group 'ps-print)

(defgroup ps-print-color nil
  "Color customization"
  :prefix "ps-"
  :tag "Color"
  :group 'ps-print)

(defgroup ps-print-face nil
  "Faces customization"
  :prefix "ps-"
  :tag "PS Faces"
  :group 'ps-print
  :group 'faces)

(defgroup ps-print-n-up nil
  "N-up customization"
  :prefix "ps-"
  :tag "N-Up"
  :group 'ps-print)

(defgroup ps-print-zebra nil
  "Zebra customization"
  :prefix "ps-"
  :tag "Zebra"
  :group 'ps-print)

(defgroup ps-print-background nil
  "Background customization"
  :prefix "ps-"
  :tag "Background"
  :group 'ps-print)

(defgroup ps-print-printer '((lpr custom-group))
  "Printer customization"
  :prefix "ps-"
  :tag "Printer"
  :group 'ps-print)

(defgroup ps-print-page nil
  "Page customization"
  :prefix "ps-"
  :tag "Page"
  :group 'ps-print)

(defgroup ps-print-miscellany nil
  "Miscellany customization"
  :prefix "ps-"
  :tag "Miscellany"
  :group 'ps-print)


(defcustom ps-error-handler-message 'paper
  "*Specify where the error handler message should be sent.

Any other value is treated as `paper'."
  :type '(choice :menu-tag "Error Handler Message"
		 :tag "Error Handler Message"
		 (const none)   (const paper)
		 (const system) (const paper-and-system))
  :group 'ps-print-miscellany)

(defcustom ps-user-defined-prologue nil
  "*User defined PostScript prologue code inserted before all prologue code.

	 (concat \"<</DeferredMediaSelection true /PageSize [612 792] \"
		 \"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))"
  :type '(choice :menu-tag "User Defined Prologue"
		 :tag "User Defined Prologue"
		 (const :tag "none" nil) string symbol)
  :group 'ps-print-miscellany)

(defcustom ps-print-prologue-header nil
  "*PostScript prologue header comments besides that ps-print generates.

more requirements put them first in `ps-print-prologue-header' using the
\"%%+\" comment.  For example, if you need to set numcopies to 3 and jog on
requirements and set %%LanguageLevel: to 2, do:

 (setq ps-print-prologue-header
      \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")

The duplex requirement is inserted by ps-print (see `ps-spool-duplex').

Do not forget to terminate the string with \"\\n\".

   Adobe Systems Incorporated
   Appendix G: Document Structuring Conventions -- Version 3.0"
  :type '(choice :menu-tag "Prologue Header"
		 :tag "Prologue Header"
		 (const :tag "none" nil) string symbol)
  :group 'ps-print-miscellany)

(defcustom ps-printer-name (and (boundp 'printer-name)
				(symbol-value 'printer-name))
  "*The name of a local printer for printing PostScript files.

		 :tag "Printer Name"
		 (const :tag "Same as printer-name" nil)
		 (const :tag "No Printer Name" t)
		 (file :tag "Print to file")
		 (string :tag "Pipe to ps-lpr-command"))
  :group 'ps-print-printer)

(defcustom ps-printer-name-option
  (cond (ps-windows-system
	 "/D:")

programs `print' and `nprint' (the standard print programs on Windows NT and
Novell Netware respectively) are handled specially, using `ps-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 'ps-print-printer)

(defcustom ps-lpr-switches lpr-switches
  "*A list of extra switches to pass to `ps-lpr-command'."
  :type '(repeat :tag "PostScript lpr Switches"
		 (choice :menu-tag "PostScript lpr Switch"
			 :tag "PostScript lpr Switch"
			 string symbol (repeat sexp)))
  :group 'ps-print-printer)

(defcustom ps-print-region-function nil
  "*Specify a function to print the region on a PostScript printer.
See definition of `call-process-region' for calling conventions.  The fourth
and the sixth arguments are both nil."
  :type '(choice (const nil) function)
  :group 'ps-print-printer)

(defcustom ps-manual-feed nil
  "*Non-nil means the printer will manually feed paper.

If it's nil, automatic feeding takes place."
  :type 'boolean
  :group 'ps-print-printer)

(defcustom ps-end-with-control-d (and ps-windows-system t)
  "*Non-nil means insert C-d at end of PostScript file generated."
  :version "21.1"
  :type 'boolean
  :group 'ps-print-printer)

;;; Page layout

;; All page dimensions are in PostScript points.

  :type '(repeat (list :tag "Paper Type"
		       (symbol :tag "Name")
		       (number :tag "Width")
		       (number :tag "Height")
		       (string :tag "Media")))
  :group 'ps-print-page)

;;;###autoload
(defcustom ps-paper-type 'letter
  "*Specify the size of paper to format for.

			     (if (assq (widget-value wid)
				       ps-page-dimensions-database)
				 nil
			       (widget-put wid :error "Unknown paper size")
			       wid)))
  :group 'ps-print-page)

(defcustom ps-warn-paper-type t
  "*Non-nil means give an error if paper size is not equal to `ps-paper-type'.

It's used when `ps-spool-config' is set to `setpagedevice'."
  :type 'boolean
  :group 'ps-print-page)

(defcustom ps-landscape-mode nil
  "*Non-nil means print in landscape mode."
  :type 'boolean
  :group 'ps-print-page)

(defcustom ps-print-upside-down nil
  "*Non-nil means print upside-down (that is, rotated by 180 degrees)."
  :type 'boolean

If nil, print all pages.

If a list, the lists element may be an integer or a cons cell (FROM . TO)
designating FROM page to TO page; any invalid element is ignored, that is, an
integer less than one or if FROM is greater than TO.

Otherwise, it's treated as nil.

After ps-print processing `ps-selected-pages' is set to nil.  But the
latest `ps-selected-pages' is saved in `ps-last-selected-pages' (which

		 (radio :tag "Page"
			(integer :tag "Number")
			(cons :tag "Range"
			      (integer :tag "From")
			      (integer :tag "To"))))
  :group 'ps-print-page)

(defcustom ps-even-or-odd-pages nil
  "*Specify if it prints even/odd pages.

		 (const :tag "All Pages" nil)
		 (const :tag "Only Even Pages" even-page)
		 (const :tag "Only Odd Pages" odd-page)
		 (const :tag "Only Even Sheets" even-sheet)
		 (const :tag "Only Odd Sheets" odd-sheet))
  :group 'ps-print-page)

(defcustom ps-print-control-characters 'control-8-bit
  "*Specify the printable form for control and 8-bit characters.
That is, instead of sending, for example, a ^D (\\004) to printer,

Any other value is treated as nil."
  :type '(choice :menu-tag "Control Char"
		 :tag "Control Char"
		 (const 8-bit)   (const control-8-bit)
		 (const control) (const :tag "nil" nil))
  :group 'ps-print-miscellany)

(defcustom ps-n-up-printing 1
  "*Specify the number of pages per sheet paper."
  :type '(integer

		nil
	      (widget-put
	       wid :error
	       "Number of pages per sheet paper must be between 1 and 100.")
	      wid)))
  :group 'ps-print-n-up)

(defcustom ps-n-up-margin (/ (* 72  1.0) 2.54) ; 1 cm
  "*Specify the margin in points between the sheet border and n-up printing."
  :type 'number
  :group 'ps-print-n-up)

(defcustom ps-n-up-border-p t
  "*Non-nil means a border is drawn around each page."
  :type 'boolean
  :group 'ps-print-n-up)

(defcustom ps-n-up-filling 'left-top
  "*Specify how page matrix is filled on each sheet of paper.

		 :tag "N-Up Filling"
		 (const left-top)  (const left-bottom)
		 (const right-top) (const right-bottom)
		 (const top-left)  (const bottom-left)
		 (const top-right) (const bottom-right))
  :group 'ps-print-n-up)

(defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
  "*Specify the number of columns."
  :type 'number
  :group 'ps-print-miscellany)

(defcustom ps-zebra-stripes nil
  "*Non-nil means print zebra stripes.
See also documentation for `ps-zebra-stripe-height' and `ps-zebra-color'."
  :type 'boolean
  :group 'ps-print-zebra)

(defcustom ps-zebra-stripe-height 3
  "*Number of zebra stripe lines.
See also documentation for `ps-zebra-stripes' and `ps-zebra-color'."
  :type 'number
  :group 'ps-print-zebra)

(defcustom ps-zebra-color 0.95
  "*Zebra stripe gray scale or RGB color.
See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."

		 (string :tag "Color Name" :value "gray95")
		 (list :tag "RGB Color" :value (0.95 0.95 0.95)
		       (number :tag "Red")
		       (number :tag "Green")
		       (number :tag "Blue")))
  :group 'ps-print-zebra)

(defcustom ps-zebra-stripe-follow nil
  "*Specify how zebra stripes continue on next page.

		20 XXXXX +   20 XXXXXXXX +   18 XXXXXX +   18               +
		21       +   21 XXXXXXXX +
		22       +   22          +
		--------     -----------     ---------     ----------------

Any other value is treated as `nil'."
  :type '(choice :menu-tag "Zebra Stripe Follow"
		 :tag "Zebra Stripe Follow"
		 (const :tag "Always Restart" nil)
		 (const :tag "Continue on Next Page" follow)
		 (const :tag "Print Only Full Stripe" full)
		 (const :tag "Continue on Full Stripe" full-follow))
  :group 'ps-print-zebra)

(defcustom ps-line-number nil
  "*Non-nil means print line number."
  :type 'boolean
  :group 'ps-print-miscellany)

(defcustom ps-line-number-step 1
  "*Specify the interval that line number is printed.

Any other value is treated as `zebra'."
  :type '(choice :menu-tag "Line Number Step"
		 :tag "Line Number Step"
		 (integer :tag "Step Interval")
		 (const :tag "Synchronize Zebra" zebra))
  :group 'ps-print-miscellany)

(defcustom ps-line-number-start 1
  "*Specify the starting point in the interval given by `ps-line-number-step'.

   * If `ps-line-number-step' is set to `zebra', must be between 1 and the
     value of `ps-zebra-strip-height' inclusive.  Use this combination if you
     wish that line number be relative to zebra stripes."
  :type '(integer :tag "Start Step Interval")
  :group 'ps-print-miscellany)

(defcustom ps-print-background-image nil
  "*EPS image list to be printed on background.

FILENAME is a file name which contains an EPS image or some PostScript
programming like EPS.
FILENAME is ignored, if it doesn't exist or is read protected.

X and Y are relative positions on paper to put the image.
If X and Y are nil, the image is centralized on paper.

XSCALE and YSCALE are scale factor to be applied to image before printing.
If XSCALE and YSCALE are nil, the original size is used.

ROTATION is the image rotation angle; if nil, the default is 0.

	   (repeat :tag "Pages" :inline t
		   (radio (integer :tag "Page")
			  (cons :tag "Range"
				(integer :tag "From")
				(integer :tag "To"))))))
  :group 'ps-print-background)

(defcustom ps-print-background-text nil
  "*Text list to be printed on background.

	   (repeat :tag "Pages" :inline t
		   (radio (integer :tag "Page")
			  (cons :tag "Range"
				(integer :tag "From")
				(integer :tag "To"))))))
  :group 'ps-print-background)

;;; Horizontal layout

;;  ------------------------------------------

;;  ------------------------------------------

(defcustom ps-left-margin   (/ (* 72  2.0) 2.54) ;   2 cm
  "*Left margin in points (1/72 inch)."
  :type 'number
  :group 'ps-print-horizontal)

(defcustom ps-right-margin  (/ (* 72  2.0) 2.54) ;   2 cm
  "*Right margin in points (1/72 inch)."
  :type 'number
  :group 'ps-print-horizontal)

(defcustom ps-inter-column  (/ (* 72  2.0) 2.54) ;   2 cm
  "*Horizontal space between columns in points (1/72 inch)."
  :type 'number
  :group 'ps-print-horizontal)

;;; Vertical layout

;; |--------|

;; |--------|

(defcustom ps-bottom-margin (/ (* 72  1.5) 2.54) ; 1.5 cm
  "*Bottom margin in points (1/72 inch)."
  :type 'number
  :group 'ps-print-vertical)

(defcustom ps-top-margin    (/ (* 72  1.5) 2.54) ; 1.5 cm
  "*Top margin in points (1/72 inch)."
  :type 'number
  :group 'ps-print-vertical)

(defcustom ps-header-offset (/ (* 72  1.0) 2.54) ; 1.0 cm
  "*Vertical space in points (1/72 inch) between the main text and the header."
  :type 'number
  :group 'ps-print-vertical)

(defcustom ps-header-line-pad 0.15
  "*Portion of a header title line height to insert.
The insertion is done between the header frame and the text it contains,
both in the vertical and horizontal directions."
  :type 'number
  :group 'ps-print-vertical)

(defcustom ps-footer-offset (/ (* 72  1.0) 2.54) ; 1.0 cm
  "*Vertical space in points (1/72 inch) between the main text and the footer."
  :type 'number
  :group 'ps-print-vertical)

(defcustom ps-footer-line-pad 0.15
  "*Portion of a footer title line height to insert.
The insertion is done between the footer frame and the text it contains,
both in the vertical and horizontal directions."
  :type 'number
  :group 'ps-print-vertical)

;;; Header/Footer setup

(defcustom ps-print-header t
  "*Non-nil means print a header at the top of each page.
By default, the header displays the buffer name, page number, and, if the
buffer is visiting a file, the file's directory.  Headers are customizable by
changing variables `ps-left-header' and `ps-right-header'."
  :type 'boolean
  :group 'ps-print-headers)

(defcustom ps-print-header-frame t
  "*Non-nil means draw a gaudy frame around the header."
  :type 'boolean
  :group 'ps-print-headers)

(defcustom ps-header-frame-alist
  '((fore-color   . 0.0)
    (back-color   . 0.9)

				(string :tag "Color Name" :value "black")
				(list :tag "RGB Color" :value (0.0 0.0 0.0)
				      (number :tag "Red")
				      (number :tag "Green")
				      (number :tag "Blue"))))))
  :group 'ps-print-headers)

(defcustom ps-header-lines 2
  "*Number of lines to display in page header, when generating PostScript."
  :type 'integer
  :group 'ps-print-headers)

(defcustom ps-print-footer nil
  "*Non-nil means print a footer at the bottom of each page.
By default, the footer displays page number.
Footers are customizable by changing variables `ps-left-footer' and
`ps-right-footer'."
  :version "21.1"
  :type 'boolean
  :group 'ps-print-headers)

(defcustom ps-print-footer-frame t
  "*Non-nil means draw a gaudy frame around the footer."
  :version "21.1"
  :type 'boolean
  :group 'ps-print-headers)

(defcustom ps-footer-frame-alist
  '((fore-color   . 0.0)
    (back-color   . 0.9)

Don't change this alist directly, instead use customization, or `ps-value',
`ps-get', `ps-put' and `ps-del' functions (see them for documentation).

See also `ps-header-frame-alist' for documentation."
  :version "21.1"
  :type '(repeat
	  (choice :menu-tag "Header Frame Element"
		  :tag ""
		  (cons :tag "Foreground Color" :format "%v"
			(const :format "" fore-color)

				(string :tag "Color Name" :value "black")
				(list :tag "RGB Color" :value (0.0 0.0 0.0)
				      (number :tag "Red")
				      (number :tag "Green")
				      (number :tag "Blue"))))))
  :group 'ps-print-headers)

(defcustom ps-footer-lines 2
  "*Number of lines to display in page footer, when generating PostScript."
  :version "21.1"
  :type 'integer
  :group 'ps-print-headers)

(defcustom ps-print-only-one-header nil
  "*Non-nil means print only one header/footer at the top/bottom of each page.
This is useful when printing more than one column, so it is possible to have
only one header/footer over all columns or one header/footer per column.
See also `ps-print-header' and `ps-print-footer'."
  :type 'boolean
  :group 'ps-print-headers)

(defcustom ps-switch-header 'duplex
  "*Specify if headers/footers are switched or not.

  :type '(choice :menu-tag "Switch Header/Footer"
		 :tag "Switch Header/Footer"
		 (const :tag "Never Switch" nil)
		 (const :tag "Always Switch" t)
		 (const :tag "Switch When Duplexing" duplex))
  :group 'ps-print-headers)

(defcustom ps-show-n-of-n t
  "*Non-nil means show page numbers as N/M, meaning page N of M.
NOTE: page numbers are displayed as part of headers,
      see variable `ps-print-header'."
  :type 'boolean
  :group 'ps-print-headers)

(defcustom ps-spool-config
  (if ps-windows-system
      nil

	 the printed file isn't OK, set `ps-spool-config' to nil."
  :type '(choice :menu-tag "Spool Config"
		 :tag "Spool Config"
		 (const lpr-switches) (const setpagedevice)
		 (const :tag "nil" nil))
  :group 'ps-print-headers)

(defcustom ps-spool-duplex nil		; Not many people have duplex printers,
					; so default to nil.
  "*Non-nil generates PostScript for a two-sided printer.

reversed on duplex printers so that the page numbers fall to the left on
even-numbered pages.

See also `ps-spool-tumble'."
  :type 'boolean
  :group 'ps-print-headers)

(defcustom ps-spool-tumble nil
  "*Specify how the page images on opposite sides of a sheet are oriented.
If `ps-spool-tumble' is nil, produces output suitable for binding on the left
or right.  If `ps-spool-tumble' is non-nil, produces output suitable for
binding at the top or bottom.

It has effect only when `ps-spool-duplex' is non-nil."
  :type 'boolean
  :group 'ps-print-headers)

;;; Fonts

(defcustom ps-font-info-database

     (fonts (normal . "Zapf-Dingbats"))
     (size . 10.0)
     (line-height . 9.63)
     (space-width . 2.78)
     (avg-char-width . 2.78))
    (Zapf-Chancery-MediumItalic
     (fonts (normal . "Zapf-Chancery-MediumItalic"))
     (size . 10.0)
     (line-height . 11.45)
     (space-width . 2.2)
     (avg-char-width . 4.10811))
    )

		      (const :format "" space-width)
		      (number :tag "Space Width"))
		(cons :format "%v"
		      (const :format "" avg-char-width)
		      (number :tag "Average Character Width"))))
  :group 'ps-print-font)

(defcustom ps-font-family 'Courier
  "*Font family name for ordinary text, when generating PostScript."
  :type 'symbol
  :group 'ps-print-font)

(defcustom ps-font-size   '(7 . 8.5)
  "*Font size, in points, for ordinary text, when generating PostScript."
  :type '(choice :menu-tag "Ordinary Text Font Size"
		 :tag "Ordinary Text Font Size"
		 (number :tag "Text Size")
		 (cons :tag "Landscape/Portrait"
		       (number :tag "Landscape Text Size")
		       (number :tag "Portrait Text Size")))
  :group 'ps-print-font)

(defcustom ps-header-font-family      'Helvetica
  "*Font family name for text in the header, when generating PostScript."
  :type 'symbol
  :group 'ps-print-font)

(defcustom ps-header-font-size       '(10 . 12)
  "*Font size, in points, for text in the header, when generating PostScript."
  :type '(choice :menu-tag "Header Font Size"
		 :tag "Header Font Size"
		 (number :tag "Header Size")
		 (cons :tag "Landscape/Portrait"
		       (number :tag "Landscape Header Size")
		       (number :tag "Portrait Header Size")))
  :group 'ps-print-font)

(defcustom ps-header-title-font-size '(12 . 14)
  "*Font size, in points, for the top line of text in header, in PostScript."
  :type '(choice :menu-tag "Header Title Font Size"
		 :tag "Header Title Font Size"
		 (number :tag "Header Title Size")
		 (cons :tag "Landscape/Portrait"
		       (number :tag "Landscape Header Title Size")
		       (number :tag "Portrait Header Title Size")))
  :group 'ps-print-font)

(defcustom ps-footer-font-family      'Helvetica
  "*Font family name for text in the footer, when generating PostScript."
  :version "21.1"
  :type 'symbol
  :group 'ps-print-font)

(defcustom ps-footer-font-size       '(10 . 12)
  "*Font size, in points, for text in the footer, when generating PostScript."
  :version "21.1"
  :type '(choice :menu-tag "Footer Font Size"
		 :tag "Footer Font Size"
		 (number :tag "Footer Size")
		 (cons :tag "Landscape/Portrait"
		       (number :tag "Landscape Footer Size")
		       (number :tag "Portrait Footer Size")))
  :group 'ps-print-font)

(defcustom ps-line-number-color      "black"
  "*Specify color for line-number, when generating PostScript."
  :type '(choice :menu-tag "Line Number Color"

  :group 'ps-print-miscellany)

(defcustom ps-line-number-font      "Times-Italic"
  "*Font for line-number, when generating PostScript."
  :type 'string
  :group 'ps-print-font
  :group 'ps-print-miscellany)

(defcustom ps-line-number-font-size 6
  "*Font size, in points, for line number, when generating PostScript."

		 :tag "Line Number Font Size"
		 (number :tag "Font Size")
		 (cons :tag "Landscape/Portrait"
		       (number :tag "Landscape Font Size")
		       (number :tag "Portrait Font Size")))
  :group 'ps-print-font
  :group 'ps-print-miscellany)

;;; Colors

  :type '(choice :menu-tag "Print Color"
		 :tag "Print Color"
		 (const :tag "Do NOT Print Color" nil)
		 (const :tag "Print Always Color" t)
		 (const :tag "Print Black/White Color" black-white))
  :group 'ps-print-color)

(defcustom ps-default-fg '(0.0 0.0 0.0) ; black
  "*RGB values of the default foreground color.  Defaults to black."
  :type '(choice :menu-tag "Default Foreground Gray/Color"
		 :tag "Default Foreground Gray/Color"
		 (const :tag "Session Foreground" t)
		 (number :tag "Gray Scale" :value 0.0)
		 (string :tag "Color Name" :value "black")
		 (list :tag "RGB Color" :value (0.0 0.0 0.0)
		       (number :tag "Red")
		       (number :tag "Green")
		       (number :tag "Blue")))
  :group 'ps-print-color)

(defcustom ps-default-bg '(1.0 1.0 1.0) ; white
  "*RGB values of the default background color.  Defaults to white."
  :type '(choice :menu-tag "Default Background Gray/Color"
		 :tag "Default Background Gray/Color"
		 (const :tag "Session Background" t)
		 (number :tag "Gray Scale" :value 1.0)
		 (string :tag "Color Name" :value "white")
		 (list :tag "RGB Color" :value (1.0 1.0 1.0)
		       (number :tag "Red")
		       (number :tag "Green")
		       (number :tag "Blue")))
  :group 'ps-print-color)

(defcustom ps-auto-font-detect t
  "*Non-nil means automatically detect bold/italic/underline face attributes.
If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces', and
`ps-underlined-faces'."
  :type 'boolean
  :group 'ps-print-font)

(defcustom ps-black-white-faces
  '((font-lock-builtin-face       "black"  nil bold       )
    (font-lock-comment-face       "gray20" nil      italic)

				(const strikeout)
				(const overline)
				(const shadow)
				(const box)
				(const outline)))))
  :group 'ps-print-face)

(defcustom ps-bold-faces
  (unless ps-print-color-p
    '(font-lock-function-name-face

      font-lock-keyword-face
      font-lock-warning-face))
  "*A list of the \(non-bold\) faces that should be printed in bold font.
This applies to generating PostScript."
  :type '(repeat face)
  :group 'ps-print-face)

(defcustom ps-italic-faces
  (unless ps-print-color-p
    '(font-lock-variable-name-face

      font-lock-comment-face
      font-lock-warning-face))
  "*A list of the \(non-italic\) faces that should be printed in italic font.
This applies to generating PostScript."
  :type '(repeat face)
  :group 'ps-print-face)

(defcustom ps-underlined-faces
  (unless ps-print-color-p
    '(font-lock-function-name-face
      font-lock-constant-face
      font-lock-warning-face))
  "*A list of the \(non-underlined\) faces that should be printed underlined.
This applies to generating PostScript."
  :type '(repeat face)
  :group 'ps-print-face)

(defcustom ps-use-face-background nil
  "*Specify if face background should be used.

		 (const :tag "Always Use Face Background" t)
		 (const :tag "Never Use Face Background" nil)
		 (repeat :menu-tag "Face Background List"
			 :tag "Face Background List"
			 face))
  :group 'ps-print-face)

(defcustom ps-left-header
  (list 'ps-get-buffer-name 'ps-header-dirpart)
  "*The items to display (each on a line) on the left part of the page header.

delimiters '(' and ')'.

For symbols with bound functions, the function is called and should return a
string to be inserted into the array.  For symbols with bound values, the value
should be a string to be inserted into the array.  In either case, function or
variable, the string value has PostScript string delimiters added to it."
  :type '(repeat (choice :menu-tag "Left Header"
			 :tag "Left Header"
			 string symbol))
  :group 'ps-print-headers)

(defcustom ps-right-header
  (list "/pagenumberstring load"
	'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)

   `ps-time-stamp-hh:mm:ss'		Return time as \"17:28:31\".

   `ps-time-stamp-mon-dd-yyyy'		Return date as \"Jun 18 2001\".

You can also create your own time stamp function by using `format-time-string'
\(which see)."
  :type '(repeat (choice :menu-tag "Right Header"
			 :tag "Right Header"
			 string symbol))
  :group 'ps-print-headers)

(defcustom ps-left-footer
  (list 'ps-get-buffer-name 'ps-header-dirpart)
  "*The items to display (each on a line) on the left part of the page footer.

')'.

For symbols with bound functions, the function is called and should return a
string to be inserted into the array.  For symbols with bound values, the value
should be a string to be inserted into the array.  In either case, function or
variable, the string value has PostScript string delimiters added to it."
  :version "21.1"
  :type '(repeat (choice :menu-tag "Left Footer"
			 :tag "Left Footer"
			 string symbol))
  :group 'ps-print-headers)

(defcustom ps-right-footer
  (list "/pagenumberstring load"
	'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)

   `ps-time-stamp-hh:mm:ss'		Return time as \"17:28:31\".

   `ps-time-stamp-mon-dd-yyyy'		Return date as \"Jun 18 2001\".

You can also create your own time stamp function by using `format-time-string'
\(which see)."
  :version "21.1"
  :type '(repeat (choice :menu-tag "Right Footer"
			 :tag "Right Footer"
			 string symbol))
  :group 'ps-print-headers)

(defcustom ps-razzle-dazzle t
  "*Non-nil means report progress while formatting buffer."
  :type 'boolean
  :group 'ps-print-miscellany)

(defcustom ps-adobe-tag "%!PS-Adobe-3.0\n"
  "*Contains the header line identifying the output as PostScript.
By default, `ps-adobe-tag' contains the standard identifier.  Some printers
require slightly different versions of this line."
  :type 'string
  :group 'ps-print-miscellany)

(defcustom ps-build-face-reference t
  "*Non-nil means build the reference face lists.

You should set this value back to t after you change the attributes of any
face, or create new faces.  Most users shouldn't have to worry about its
setting, though."
  :type 'boolean
  :group 'ps-print-face)

(defcustom ps-always-build-face-reference nil
  "*Non-nil means always rebuild the reference face lists.

If this variable is non-nil, ps-print will rebuild its internal reference lists
of bold and italic faces *every* time one of the ...-with-faces commands is
called.  Most users shouldn't need to set this variable."
  :type 'boolean
  :group 'ps-print-face)

(defcustom ps-banner-page-when-duplexing nil
  "*Non-nil means the very first page is skipped.
It's like the very first character of buffer (or region) is ^L (\\014)."
  :type 'boolean
  :group 'ps-print-headers)

(defcustom ps-postscript-code-directory
  (or (cond
       ((eq ps-print-emacs-type 'emacs)	; emacs
	data-directory)
       ((fboundp 'locate-data-directory) ; xemacs
	(locate-data-directory "ps-print"))
       ((boundp 'data-directory)	; xemacs
	data-directory)
       (t				; don't know what to do
	nil))
      (error "`ps-postscript-code-directory' isn't set properly"))
  "*Directory where it's located the PostScript prologue file used by ps-print.
By default, this directory is the same as in the variable `data-directory'."
  :type 'directory
  :group 'ps-print-miscellany)

(defcustom ps-line-spacing 0
  "*Specify line spacing, in points, for ordinary text.

  (let (ps-prefix-quote)
    (mapconcat
     #'ps-print-quote
     (list
      (concat "\n;;; ps-print version " ps-print-version "\n")
      '(25 . ps-print-color-p)
      '(25 . ps-lpr-command)
      '(25 . ps-lpr-switches)
      '(25 . ps-printer-name)
      '(25 . ps-printer-name-option)

		  "      "
		(setq ps-prefix-quote t)
		"(setq ")
	      key
	      (if (> col len)
		  (make-string (- col len) ?\ )
		" ")
	      (cond ((null val) "nil")
		    ((eq val t) "t")
		    ((or (symbolp val) (listp val)) (format "'%S" val))
		    (t          (format "%S" val))))))
   (t "")
   ))


(defun ps-value (alist-sym key)
  "Return value from association list ALIST-SYM which car is `eq' to KEY."
  (cdr (assq key (symbol-value alist-sym))))

(defun ps-time-stamp-mon-dd-yyyy ()
  "Return date as \"Jun 18 2001\"."
  (format-time-string "%b %d %Y"))


(defun ps-time-stamp-hh:mm:ss ()
  "Return time as \"17:28:31\"."
  (format-time-string "%T"))


(eval-and-compile
  (and (eq ps-print-emacs-type 'xemacs)
       ;; XEmacs change: Need to check for emacs-major-version too.
       (or (< emacs-major-version 19)
	   (and (= emacs-major-version 19) (< emacs-minor-version 12)))
       (setq ps-print-color-p nil))


  ;; Return t if the device (which can be changed during an emacs session)
  ;; can handle colors.
  ;; This function is not yet implemented for GNU emacs.
  (cond ((and (eq ps-print-emacs-type 'xemacs)
	      ;; XEmacs change: Need to check for emacs-major-version too.
	      (or (> emacs-major-version 19)
		  (and (= emacs-major-version 19)
		       (>= emacs-minor-version 12)))) ; xemacs >= 19.12
	 (defun ps-color-device ()
	   (eq (ps-x-device-class) 'color)))

	(t				; emacs
	 (defun ps-color-device ()
	   (if (fboundp 'color-values)
	       (ps-e-color-values "Green")
	     t))))


  (defun ps-mapper (extent list)
    (nconc list
	   (list (list (ps-x-extent-start-position extent) 'push extent)
		 (list (ps-x-extent-end-position extent) 'pull extent)))
    nil)

  (defun ps-extent-sorter (a b)
    (< (ps-x-extent-priority a) (ps-x-extent-priority b)))

  (defun ps-xemacs-face-kind-p (face kind kind-regex)
    (let* ((frame-font (or (ps-x-face-font-instance face)
			   (ps-x-face-font-instance 'default)))
	   (kind-cons
	    (and frame-font
		 (assq kind
		       (ps-x-font-instance-properties frame-font))))
	   (kind-spec (cdr-safe kind-cons))
	   (case-fold-search t))
      (and kind-spec (string-match kind-regex kind-spec))))

  (cond ((eq ps-print-emacs-type 'emacs) ; emacs

	 (defun ps-color-values (x-color)
	   (cond
	    ((fboundp 'color-values)
	     (ps-e-color-values x-color))
	    ((fboundp 'x-color-values)
	     (ps-e-x-color-values x-color))
	    (t
	     (error "No available function to determine X color values"))))

	 (defun ps-face-bold-p (face)
	   (or (ps-e-face-bold-p face)
	       (memq face ps-bold-faces)))

	 (defun ps-face-italic-p (face)
	   (or (ps-e-face-italic-p face)
	       (memq face ps-italic-faces)))
	 )

	(t				; xemacs

	 ;; to avoid XEmacs compilation gripes
	 (defvar coding-system-for-write   nil)
	 (defvar coding-system-for-read    nil)
	 (defvar buffer-file-coding-system nil)

	 (and (fboundp 'find-coding-system)
	      (or (ps-x-find-coding-system 'raw-text-unix)
		  (ps-x-copy-coding-system 'no-conversion-unix 'raw-text-unix)))

	 (defun ps-color-values (x-color)
	   (let ((color (ps-xemacs-color-name x-color)))
	     (cond
	      ((fboundp 'x-color-values)
	       (ps-e-x-color-values color))
	      ((and (fboundp 'color-instance-rgb-components)
		    (ps-color-device))
	       (ps-x-color-instance-rgb-components
		(if (ps-x-color-instance-p x-color)
		    x-color
		  (ps-x-make-color-instance color))))
	      (t
	       (error "No available function to determine X color values")))))

	 (defun ps-face-bold-p (face)
	   (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
	       (memq face ps-bold-faces))) ; Kludge-compatible

	 (defun ps-face-italic-p (face)
	   (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o")
	       (ps-xemacs-face-kind-p face 'SLANT "i\\|o")
	       (memq face ps-italic-faces))) ; Kludge-compatible
	 )))


(defvar ps-print-color-scale 1.0)

(defun ps-color-scale (color)

(defvar ps-background-text-count 0)
(defvar ps-background-image-count 0)

(defvar ps-current-font 0)
(defvar ps-default-foreground nil)
(defvar ps-default-color nil)
(defvar ps-current-color nil)
(defvar ps-current-bg nil)

(defvar ps-zebra-stripe-full-p nil)
(defvar ps-razchunk 0)

(defvar ps-color-p nil)
(defvar ps-color-format
  (if (eq ps-print-emacs-type 'emacs)

      ;; Emacs understands the %f format; we'll use it to limit color RGB
      ;; values to three decimals to cut down some on the size of the
      ;; PostScript output.
      "%0.3f %0.3f %0.3f"

    ;; XEmacs will have to make do with %s (princ) for floats.
    "%s %s %s"))

;; These values determine how much print-height to deduct when headers/footers
;; are turned on.  This is a pretty clumsy way of handling it, but it'll do for
;; now.

  "Extend face in ALIST-SYM.

If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
with face extension in ALIST-SYM; otherwise, overrides.

If optional ALIST-SYM is nil, it's used `ps-print-face-extension-alist';
otherwise, it should be an alist symbol.

The elements in FACE-EXTENSION-LIST is like those for `ps-extend-face'.

See `ps-extend-face' for documentation."
  (while face-extension-list
    (ps-extend-face (car face-extension-list) merge-p alist-sym)
    (setq face-extension-list (cdr face-extension-list))))

  "Extend face in ALIST-SYM.

If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
with face extensions in ALIST-SYM; otherwise, overrides.

If optional ALIST-SYM is nil, it's used `ps-print-face-extension-alist';
otherwise, it should be an alist symbol.

The elements of FACE-EXTENSION list have the form:

   (FACE-NAME FOREGROUND BACKGROUND EXTENSION...)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal functions and variables


(defvar ps-print-hook nil)
(defvar ps-print-begin-sheet-hook nil)
(defvar ps-print-begin-page-hook nil)
(defvar ps-print-begin-column-hook nil)

  (ps-spool-without-faces from to region-p)
  (ps-do-despool filename))


(defun ps-spool-without-faces (from to &optional region-p)
  (run-hooks 'ps-print-hook)
  (ps-printing-region region-p from)
  (ps-generate (current-buffer) from to 'ps-generate-postscript))


(defun ps-print-with-faces (from to &optional filename region-p)
  (ps-spool-with-faces from to region-p)
  (ps-do-despool filename))


(defun ps-spool-with-faces (from to &optional region-p)
  (run-hooks 'ps-print-hook)
  (ps-printing-region region-p from)
  (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces))


(defun ps-count-lines-preprint (from to)
   (or (and from to)
       (error "The mark is not set now"))
   (list (count-lines from to)))


(defun ps-count-lines (from to)
  (+ (count-lines from to)
     (save-excursion
       (goto-char to)
       (if (= (current-column) 0) 1 0))))


(defvar ps-printing-region nil
  "Variable used to indicate if the region that ps-print is printing.
It is a cons, the car of which is the line number where the region begins, and
its cdr is the total number of lines in the buffer.  Formatting functions can
use this information to print the original line number (and not the number of
lines printed), and to indicate in the header that the printout is of a partial
file.")

(defvar ps-printing-region-p nil
  "Non-nil means ps-print is printing a region.")


(defun ps-printing-region (region-p from)
  (setq ps-printing-region-p region-p
	ps-printing-region
	(cons (if region-p
		  (ps-count-lines (point-min) from)
		1)
	      (ps-count-lines (point-min) (point-max)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

       (or (numberp prefix-arg)
	   (listp prefix-arg))
       (let* ((name   (concat (file-name-nondirectory (or (buffer-file-name)
							  (buffer-name)))
			      ".ps"))
	      (prompt (format "Save PostScript to file: (default %s) " name))
	      (res    (read-file-name prompt default-directory name nil)))
	 (while (cond ((file-directory-p res)
		       (ding)
		       (setq prompt "It's a directory"))
		      ((not (file-writable-p res))

(defun ps-insert-file (fname)
  (ps-flush-output)
  (save-excursion
    (set-buffer ps-spool-buffer)
    (goto-char (point-max))
    (insert-file fname)))

;; These functions insert the arrays that define the contents of the headers.

(defun ps-generate-header-line (fonttag &optional content)
  (ps-output " [" fonttag " ")

   ((stringp content)
    (ps-output (ps-mule-encode-header-string content fonttag)))

   ;; Functions are called -- they should return strings; they will be inserted
   ;; as strings and the PS string delimiters added.
   ((and (symbolp content) (fboundp content))
    (ps-output-string (ps-mule-encode-header-string (funcall content)
						    fonttag)))

   ;; Variables will have their contents inserted.  They should contain
   ;; strings, and will be inserted as strings.

;; Emacs understands the %f format; we'll use it to limit color RGB values
;; to three decimals to cut down some on the size of the PostScript output.
;; XEmacs will have to make do with %s (princ) for floats.

(defvar ps-float-format (if (eq ps-print-emacs-type 'emacs)
			    "%0.3f "	; emacs
			  "%s "))	; xemacs


(defun ps-float-format (value &optional default)
  (let ((literal (or value default)))
    (cond ((null literal)

			     "PrintPageWidth 2 div")
	    (ps-float-format (nth 2 image) ; y position
			     "PrintHeight 2 div BottomMargin add")
	    "\nBeginBackImage\n")
	   (ps-insert-file image-file)
	   ;; coordinate adjustment to centralize image
	   ;; around x and y position
	   (let ((box (ps-get-boundingbox)))
	     (save-excursion
	       (set-buffer ps-spool-buffer)
	       (save-excursion

    (and ps-n-up-on (setq tumble (not tumble)))
    (ps-output
     ps-adobe-tag
     "%%Title: " (buffer-name)		; Take job name from name of
					; first buffer printed
     "\n%%Creator: " (user-full-name)
     " (using ps-print v" ps-print-version
     ")\n%%CreationDate: " (format-time-string "%T %b %d %Y")
     "\n%%Orientation: "
     (if ps-landscape-mode "Landscape" "Portrait")
     "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
     (mapconcat 'identity
		(ps-remove-duplicates
		 (append (ps-fonts 'ps-font-for-text)
			 (list (ps-font 'ps-font-for-header 'normal)
			       (ps-font 'ps-font-for-header 'bold))))
		"\n%%+ font ")
     "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
     (format " %d" (round (ps-page-dimensions-get-width dimensions)))
     (format " %d" (round (ps-page-dimensions-get-height dimensions)))
     " 0 () ()\n%%PageOrder: Ascend\n%%Pages: (atend)\n%%Requirements:"
     (if ps-spool-duplex

	       (format "/ErrorMessage  %s def\n\n"
		       (or (cdr (assoc ps-error-handler-message
				       ps-error-handler-alist))
			   1))		; send to paper
	       ps-print-prologue-0
	       "\n%%BeginProcSet: UserDefinedPrologue\n\n")

    (ps-insert-string ps-user-defined-prologue)

    (ps-output "\n%%EndProcSet\n\n")

    (ps-output-boolean "LandscapeMode      "
		       (or ps-landscape-mode
			   (eq (ps-n-up-landscape n-up) 'pag)))
    (ps-output-boolean "UpsideDown         " ps-print-upside-down)

	       (format "def\n/ZebraHeight      %d def\n"
		       ps-zebra-stripe-height)
	       "/ZebraColor       "
	       (ps-format-color ps-zebra-color 0.95)
	       "def\n/BackgroundColor  "
	       (ps-format-color
		(if (eq ps-default-bg t)
		    (ps-face-background-name 'default)
		  ps-default-bg)
		1.0)
	       "def\n/UseSetpagedevice "
	       (if (eq ps-spool-config 'setpagedevice)
		   "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
		 "false")
	       " def\n\n/PageWidth "

    (ps-background-text)
    (ps-background-image)
    (setq ps-background-all-pages (nreverse ps-background-all-pages)
	  ps-background-pages (nreverse ps-background-pages))

    (ps-output "\n" ps-print-prologue-1)

    (ps-output "\n/printGlobalBackground{\n")
    (mapcar 'ps-output ps-background-all-pages)
    (ps-output "}def\n/printLocalBackground{\n}def\n")

    ;; Header/line number fonts
    (ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
		       ps-header-title-font-size-internal
		       (ps-font 'ps-font-for-header 'bold))
	       (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont
		       ps-header-font-size-internal
		       (ps-font 'ps-font-for-header 'normal))
	       (format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont
		       (ps-get-font-size 'ps-line-number-font-size)
		       ps-line-number-font)
	       (format "/H0 %s(%s)cvn DefFont\n" ; /H0 12/Helvetica DefFont
		       ps-footer-font-size-internal
		       (ps-font 'ps-font-for-footer 'normal))
	       "\n\n% ---- These lines must be kept together because...

/h0 F
/HeaderTitleLineHeight FontHeight def

/h1 F

    (let ((font-entry (cdr (assq ps-font-family ps-font-info-database))))
      (ps-output (format "/SpaceWidthRatio %f def\n"
			 (/ (ps-lookup 'space-width) (ps-lookup 'size)))))

    (ps-output "\n%%EndProlog\n\n%%BeginSetup\n")
    (unless (eq ps-spool-config 'lpr-switches)
      (ps-output "\n%%BeginFeature: *Duplex "
		 (ps-boolean-capitalized ps-spool-duplex)
		 " *Tumble "
		 (ps-boolean-capitalized tumble)

(defun ps-get-font-size (font-sym)
  (ps-get-size (symbol-value font-sym) "font size" font-sym))


(defsubst ps-rgb-color (color default)
  (cond ((and color (listp color)) color)
	((stringp color) (ps-color-scale color))
	((numberp color) (list color color color))
	(t (list default default default))
	))


(defun ps-begin-job ()

	      ((eq ps-print-control-characters 'control-8-bit)
	       (string-as-unibyte "[\000-\037\177-\237]"))
	      ((eq ps-print-control-characters 'control)
	       "[\000-\037\177]")
	      (t "[\t\n\f]"))
	ps-default-foreground (ps-rgb-color
			       (if (eq ps-default-fg t)
				   (ps-face-foreground-name 'default)
				 ps-default-fg)
			       0.0)

	ps-color-p           (and ps-print-color-p (ps-color-device))
	ps-print-color-scale (if ps-color-p
				 (float (car (ps-color-values "white")))
			       1.0))
  ;; initialize page dimensions
  (ps-get-page-dimensions))


(defun ps-page-number ()
  (if ps-print-only-one-header
      (1+ (/ (1- ps-page-column) ps-number-of-columns))

  (ps-end-page)
  (ps-flush-output)
  (ps-begin-page))


(defun ps-header-sheet ()
  ;; Print only when a new sheet begins.
  (and ps-print-page-p (> ps-page-sheet 0)
       (ps-output "EndSheet\n"))
  (setq ps-page-sheet (1+ ps-page-sheet))
  (when (ps-print-sheet-p)
    (setq ps-page-order (1+ ps-page-order))
    (ps-output (if ps-n-up-on
		   (format "\n%%%%Page: (%d \\(%d\\)) %d\n"

  (ps-output (format "/LineNumber %d def\n" ps-showline-count)
	     (format "/PageNumber %d def\n" (ps-page-number)))

  (when ps-print-header
    (ps-generate-header "HeaderLinesLeft"  "/h0" "/h1" ps-left-header)
    (ps-generate-header "HeaderLinesRight" "/h0" "/h1" ps-right-header)
    (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))

  (when ps-print-footer
    (ps-generate-header "FooterLinesLeft"  "/H0" "/H0" ps-left-footer)
    (ps-generate-header "FooterLinesRight" "/H0" "/H0" ps-right-footer)
    (ps-output (format "%d SetFooterLines\n" ps-footer-lines)))

  (ps-output (number-to-string ps-lines-printed) " BeginPage\n")
  (ps-set-font  ps-current-font)
  (ps-set-bg    ps-current-bg)
  (ps-set-color ps-current-color)

  (ps-plot 'ps-basic-plot-str 0 (length string) string))


(defvar ps-current-effect 0)


(defun ps-plot-region (from to font &optional fg-color bg-color effects)
  (or (equal font ps-current-font)
      (ps-set-font font))

	     (composition		; a composite sequence
	      (ps-plot 'ps-mule-plot-composition match-point (point) bg-color))

	     ((> match 255)		; a multi-byte character
	      (let* ((charset (char-charset match))
		     (composition (ps-e-find-composition match-point to))
		     (stop (if (nth 2 composition) (car composition) to)))
		(or (eq charset 'composition)
		    (while (and (< (point) stop) (eq (charset-after) charset))
		      (forward-char 1)))
		(ps-plot 'ps-mule-plot-string match-point (point) bg-color)))
					; characters from ^@ to ^_ and
	     (t				; characters from 127 to 255
	      (ps-control-character match)))

		(ps-face-foreground-name face)
		(ps-face-background-name face))))


;; to avoid compilation gripes
(defun ps-print-ensure-fontified (start end)
  (cond
   ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
    (defalias 'ps-jitify 'jit-lock-fontify-now) ; avoid compilation gripes
    (ps-jitify start end))
   ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
    (defalias 'ps-lazify 'lazy-lock-fontify-region) ; avoid compilation gripes
    (ps-lazify start end))))


(defun ps-generate-postscript-with-faces (from to)
  ;; Some initialization...
  (setq ps-current-effect 0)

    (narrow-to-region from to)
    (ps-print-ensure-fontified from to)
    (let ((face 'default)
	  (position to))
      (cond
       ((eq ps-print-emacs-type 'xemacs)
	;; Build the list of extents...
	(let ((a (cons 'dummy nil))
	      record type extent extent-list)
	  (ps-x-map-extents 'ps-mapper nil from to a)
	  (setq a (sort (cdr a) 'car-less-than-car)

			   (ps-x-extent-face (car extent-list))
			 'default)
		  from position
		  a (cdr a)))))

       ((eq ps-print-emacs-type 'emacs)
	(let ((property-change from)
	      (overlay-change from)
	      (save-buffer-invisibility-spec buffer-invisibility-spec)
	      (buffer-invisibility-spec nil)
	      before-string after-string)

	(and ps-razzle-dazzle (message "Formatting...done"))))))


(defun ps-end-job (needs-begin-file)
  (let ((previous-print ps-print-page-p)
	(ps-print-page-p t))
    (ps-flush-output)
    (save-excursion
      (let ((pages-per-sheet (mod ps-page-printed ps-n-up-printing))
	    (total-lines (cdr ps-printing-region))
	    (total-pages (ps-page-number)))

	   (ps-output "/PrintHeader false def\n/ColumnIndex 0 def\n"
		      "/PrintLineNumber false def\n"
		      (number-to-string ps-lines-printed) " BeginPage\n")
	   (ps-end-page)))
    ;; Set end of PostScript file
    (and previous-print
	 (ps-output "EndSheet\n"))
    (ps-output "\n%%Trailer\n%%Pages: "
	       (number-to-string
		(if (and needs-begin-file
			 ps-banner-page-when-duplexing)
		    (1+ ps-page-order)

	(t (list list))))

(defun ps-kill-emacs-check ()
  (let (ps-buffer)
    (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
	 (buffer-modified-p ps-buffer)
	 (y-or-n-p "Unprinted PostScript waiting; print now? ")
	 (ps-despool))
    (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
	 (buffer-modified-p ps-buffer)
	 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
	 (error "Unprinted PostScript"))))

(cond ((fboundp 'add-hook)

;; WARNING!!! The following code is *sample* code only.
;; Don't use it unless you understand what it does!

(defmacro ps-prsc ()
  `(if (eq ps-print-emacs-type 'emacs) [f22] 'f22))
(defmacro ps-c-prsc ()
  `(if (eq ps-print-emacs-type 'emacs) [C-f22] '(control f22)))
(defmacro ps-s-prsc ()
  `(if (eq ps-print-emacs-type 'emacs) [S-f22] '(shift f22)))

;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the
;; `ps-left-headers' specially for mail messages.
(defun ps-rmail-mode-hook ()
  (local-set-key (ps-prsc) 'ps-rmail-print-message-from-summary)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(provide 'ps-print)

;;; ps-print.el ends here

88155:d7ddb3e565de

;;; ps-print.el --- print text from the buffer as PostScript

;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
;;   2002, 2003, 2004, 2005 Free Software Foundation, Inc.

;; Author: Jim Thompson (was <[e-mail]>)
;;	Jacques Duthen (was <[e-mail]>)
;;	Vinicius Jose Latorre <[e-mail]>
;;	Kenichi Handa <[e-mail]> (multi-byte characters)
;; Maintainer: Kenichi Handa <[e-mail]> (multi-byte characters)
;;	Vinicius Jose Latorre <[e-mail]>
;; Keywords: wp, print, PostScript
;; Time-stamp: <2005/06/27 00:57:22 vinicius>
;; Version: 6.6.7
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/

(defconst ps-print-version "6.6.7"
  "ps-print.el, v 6.6.7 <2005/06/27 vinicius>

Vinicius's last change version -- this file may have been edited as part of
Emacs without changes to the version number.  When reporting bugs, please also
report the version of Emacs, if any, that ps-print was distributed with.

Please send all bug fixes and enhancements to
	Vinicius Jose Latorre <[e-mail]>.")

;; 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

;; 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.

;;; Commentary:

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;

;;		20 XXXXX +   20 XXXXXXXX +   18 XXXXXX +   18               +
;;		21       +   21 XXXXXXXX +
;;		22       +   22          +
;;		--------     -----------     ---------     ----------------
;;
;; Any other value is treated as nil.
;;
;; See also section How Ps-Print Has A Text And/Or Image On Background.
;;
;;
;; Hooks

;;
;; You can create new `mixed' font families like:
;;      (my-mixed-family
;;       (fonts (normal               . "Courier-Bold")
;;              (bold                 . "Helvetica")
;;              (italic               . "ZapfChancery-MediumItalic")
;;              (bold-italic          . "NewCenturySchlbk-BoldItalic")
;;              (w3-table-hack-x-face . "LineDrawNormal"))
;;       (size . 10.0)
;;       (line-height . 10.55)
;;       (space-width . 6.0)

;;      (my-mixed-family
;;       (size . 10.0)
;;       (fonts (w3-table-hack-x-face . "LineDrawNormal")
;;              (bold                 . "Helvetica")
;;              (bold-italic          . "NewCenturySchlbk-BoldItalic")
;;              (italic               . "ZapfChancery-MediumItalic")
;;              (normal               . "Courier-Bold"))
;;       (avg-char-width . 6.0)
;;       (space-width . 6.0)
;;       (line-height . 10.55))
;;

;;    t		always use face background color.
;;    nil	never use face background color.
;;    (face...)	list of faces whose background color will be used.
;;
;; Any other value will be treated as t.
;; The default value is nil.
;;
;;
;; How Ps-Print Deals With Color
;; -----------------------------
;;

;;
;;
;; New since version 2.8
;; ---------------------
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    20040229
;;	 `ps-time-stamp-yyyy-mm-dd', `ps-time-stamp-iso8601'
;;
;;    20010619
;;	 `ps-time-stamp-locale-default'
;;
;;    20010530

;;
;;    19990513
;;	 N-up printing.
;;	 Hook: `ps-print-begin-sheet-hook'.
;;
;; [kenichi] 19990509 Ken'ichi Handa <[e-mail]>
;;
;;    `ps-print-region-function'
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    19990301
;;	 PostScript tumble and setpagedevice.
;;
;;    19980922
;;	 PostScript prologue header comment insertion.
;;	 Skip invisible text better.
;;
;; [kenichi] 19980819 Ken'ichi Handa <[e-mail]>
;;
;;    Multi-byte buffer handling.
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    19980306
;;	 Skip invisible text.
;;
;;    19971130

;;
;;
;; Acknowledgments
;; ---------------
;;
;; Thanks to Michael Piotrowski <[e-mail]> for improving the DSC
;; compliance of the generated PostScript.
;;
;; Thanks to Adam Doppelt <[e-mail]> for face mapping suggestion
;; for black/white PostScript printers.
;;
;; Thanks to Toni Ronkko <[e-mail]> for line and paragraph spacing,
;; region to cut out when printing and footer suggestions.

;; suggestion for `ps-postscript-code-directory' variable.
;;
;; Thanks to David X Callaway <[e-mail]> for helping debugging PostScript
;; level 1 compatibility.
;;
;; Thanks to Colin Marquardt <[e-mail]> for:
;;    - upside-down, line number step, line number start and zebra stripe
;;	follow suggestions.
;;    - `ps-time-stamp-yyyy-mm-dd' and `ps-time-stamp-iso8601' suggestion.
;;    - and for XEmacs beta-tests.
;;
;; Thanks to Klaus Berndl <[e-mail]> for user defined PostScript
;; prologue code suggestion, for odd/even printing suggestion and for
;; `ps-prologue-file' enhancement.
;;
;; Thanks to Ken'ichi Handa <[e-mail]> for multi-byte buffer handling.
;;
;; Thanks to Matthew O Persico <[e-mail]> for line number on
;; empty columns.
;;
;; Thanks to Theodore Jump <[e-mail]> for adjust PostScript code order on

;;
;; Thanks to Avishai Yacobi, [e-mail], for writing the
;; initial port to Emacs 19.  His code is no longer part of ps-print, but his
;; work is still appreciated.
;;
;; Thanks to Remi Houdaille and Michel Train <[e-mail]> for
;; adding underline support.  Their code also is no longer part of ps-print,
;; but their efforts are not forgotten.
;;
;; Thanks also to all of you who mailed code to add features to ps-print;
;; although I didn't use your code, I still appreciate your sharing it with me.

;; Jim
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Code:


(require 'lpr)

(or (featurep 'lisp-float-type)
    (error "`ps-print' requires floating point support"))


(defvar ps-print-emacs-type
  (let ((case-fold-search t))
    (cond ((string-match "XEmacs" emacs-version) 'xemacs)
	  ((string-match "Lucid" emacs-version)
	   (error "`ps-print' doesn't support Lucid"))
	  ((string-match "Epoch" emacs-version)
	   (error "`ps-print' doesn't support Epoch"))
	  (t
	   (unless (and (boundp 'emacs-major-version)
			(> emacs-major-version 19))
	     (error "`ps-print' only supports Emacs 20 and higher"))
	   'emacs))))


;; For Emacs 20.2 and the earlier version.

(or (fboundp 'set-buffer-multibyte)
    (defun set-buffer-multibyte (arg)
      (setq enable-multibyte-characters arg)))

(or (fboundp 'string-as-unibyte)
    (defun string-as-unibyte (arg) arg))

(or (fboundp 'string-as-multibyte)
    (defun string-as-multibyte (arg) arg))

(or (fboundp 'char-charset)
    (defun char-charset (arg) 'ascii))

(or (fboundp 'charset-after)
    (defun charset-after (&optional arg)
      (char-charset (char-after arg))))


;; GNU Emacs
(or (fboundp 'line-beginning-position)
    (defun line-beginning-position (&optional n)
      (save-excursion
	(and n (/= n 1) (forward-line (1- n)))
	(beginning-of-line)
	(point))))


;; to avoid compilation gripes

;; XEmacs
(defalias 'ps-x-color-instance-p              'color-instance-p)
(defalias 'ps-x-color-instance-rgb-components 'color-instance-rgb-components)
(defalias 'ps-x-color-name                    'color-name)
(defalias 'ps-x-color-specifier-p             'color-specifier-p)
(defalias 'ps-x-copy-coding-system            'copy-coding-system)
(defalias 'ps-x-device-class                  'device-class)
(defalias 'ps-x-extent-end-position           'extent-end-position)
(defalias 'ps-x-extent-face                   'extent-face)
(defalias 'ps-x-extent-priority               'extent-priority)
(defalias 'ps-x-extent-start-position         'extent-start-position)
(defalias 'ps-x-face-font-instance            'face-font-instance)
(defalias 'ps-x-find-coding-system            'find-coding-system)
(defalias 'ps-x-font-instance-properties      'font-instance-properties)
(defalias 'ps-x-make-color-instance           'make-color-instance)
(defalias 'ps-x-map-extents                   'map-extents)

;; GNU Emacs
(defalias 'ps-e-face-bold-p         'face-bold-p)
(defalias 'ps-e-face-italic-p       'face-italic-p)
(defalias 'ps-e-next-overlay-change 'next-overlay-change)
(defalias 'ps-e-overlays-at         'overlays-at)
(defalias 'ps-e-overlay-get         'overlay-get)
(defalias 'ps-e-overlay-end         'overlay-end)
(defalias 'ps-e-x-color-values      'x-color-values)
(defalias 'ps-e-color-values        'color-values)
(if (fboundp 'find-composition)
    (defalias 'ps-e-find-composition 'find-composition)
  (defalias 'ps-e-find-composition 'ignore))


(defconst ps-windows-system
  (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
(defconst ps-lp-system
  (memq system-type '(usg-unix-v dgux hpux irix)))


(defun ps-xemacs-color-name (color)
  (if (ps-x-color-specifier-p color)
      (ps-x-color-name color)
    color))


(cond ((featurep 'xemacs)		; xemacs
       (defalias 'ps-mark-active-p 'region-active-p)
       (defun ps-face-foreground-name (face)
	 (ps-xemacs-color-name (face-foreground face)))
       (defun ps-face-background-name (face)
	 (ps-xemacs-color-name (face-background face)))
       )
      (t				; emacs
       (defvar mark-active nil)
       (defun ps-mark-active-p ()
	 mark-active)
       (defun ps-face-foreground-name (face)
	 (face-foreground face nil t))
       (defun ps-face-background-name (face)
	 (face-background face nil t))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User Variables:


;;; Interface to the command system

(defgroup postscript nil
  "PostScript Group."
  :tag "PostScript"
  :version "20"
  :group 'emacs)

(defgroup ps-print nil
  "PostScript generator for Emacs."
  :link '(emacs-library-link :tag "Source Lisp File" "ps-print.el")
  :prefix "ps-"
  :version "20"
  :group 'wp
  :group 'postscript)

(defgroup ps-print-horizontal nil
  "Horizontal page layout."
  :prefix "ps-"
  :tag "Horizontal"
  :version "20"
  :group 'ps-print)

(defgroup ps-print-vertical nil
  "Vertical page layout."
  :prefix "ps-"
  :tag "Vertical"
  :version "20"
  :group 'ps-print)

(defgroup ps-print-headers nil
  "Headers & footers layout."
  :prefix "ps-"
  :tag "Header & Footer"
  :version "20"
  :group 'ps-print)

(defgroup ps-print-font nil
  "Fonts customization."
  :prefix "ps-"
  :tag "Font"
  :version "20"
  :group 'ps-print)

(defgroup ps-print-color nil
  "Color customization."
  :prefix "ps-"
  :tag "Color"
  :version "20"
  :group 'ps-print)

(defgroup ps-print-face nil
  "Faces customization."
  :prefix "ps-"
  :tag "PS Faces"
  :version "20"
  :group 'ps-print
  :group 'faces)

(defgroup ps-print-n-up nil
  "N-up customization."
  :prefix "ps-"
  :tag "N-Up"
  :version "20"
  :group 'ps-print)

(defgroup ps-print-zebra nil
  "Zebra customization."
  :prefix "ps-"
  :tag "Zebra"
  :version "20"
  :group 'ps-print)

(defgroup ps-print-background nil
  "Background customization."
  :prefix "ps-"
  :tag "Background"
  :version "20"
  :group 'ps-print)

(defgroup ps-print-printer '((lpr custom-group))
  "Printer customization."
  :prefix "ps-"
  :tag "Printer"
  :version "20"
  :group 'ps-print)

(defgroup ps-print-page nil
  "Page customization."
  :prefix "ps-"
  :tag "Page"
  :version "20"
  :group 'ps-print)

(defgroup ps-print-miscellany nil
  "Miscellany customization."
  :prefix "ps-"
  :tag "Miscellany"
  :version "20"
  :group 'ps-print)


(defcustom ps-error-handler-message 'paper
  "*Specify where the error handler message should be sent.

Any other value is treated as `paper'."
  :type '(choice :menu-tag "Error Handler Message"
		 :tag "Error Handler Message"
		 (const none)   (const paper)
		 (const system) (const paper-and-system))
  :version "20"
  :group 'ps-print-miscellany)

(defcustom ps-user-defined-prologue nil
  "*User defined PostScript prologue code inserted before all prologue code.

	 (concat \"<</DeferredMediaSelection true /PageSize [612 792] \"
		 \"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))"
  :type '(choice :menu-tag "User Defined Prologue"
		 :tag "User Defined Prologue"
		 (const :tag "none" nil) string symbol)
  :version "20"
  :group 'ps-print-miscellany)

(defcustom ps-print-prologue-header nil
  "*PostScript prologue header comments besides that ps-print generates.

more requirements put them first in `ps-print-prologue-header' using the
\"%%+\" comment.  For example, if you need to set numcopies to 3 and jog on
requirements and set %%LanguageLevel: to 2, do:

 (setq ps-print-prologue-header
       \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")

The duplex requirement is inserted by ps-print (see `ps-spool-duplex').

Do not forget to terminate the string with \"\\n\".

   Adobe Systems Incorporated
   Appendix G: Document Structuring Conventions -- Version 3.0"
  :type '(choice :menu-tag "Prologue Header"
		 :tag "Prologue Header"
		 (const :tag "none" nil) string symbol)
  :version "20"
  :group 'ps-print-miscellany)

(defcustom ps-printer-name (and (boundp 'printer-name)
				(symbol-value 'printer-name))
  "*The name of a local printer for printing PostScript files.

		 :tag "Printer Name"
		 (const :tag "Same as printer-name" nil)
		 (const :tag "No Printer Name" t)
		 (file :tag "Print to file")
		 (string :tag "Pipe to ps-lpr-command"))
  :version "20"
  :group 'ps-print-printer)

(defcustom ps-printer-name-option
  (cond (ps-windows-system
	 "/D:")

programs `print' and `nprint' (the standard print programs on Windows NT and
Novell Netware respectively) are handled specially, using `ps-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
  :version "20"
  :group 'ps-print-printer)

(defcustom ps-lpr-switches lpr-switches
  "*A list of extra switches to pass to `ps-lpr-command'."
  :type '(repeat :tag "PostScript lpr Switches"
		 (choice :menu-tag "PostScript lpr Switch"
			 :tag "PostScript lpr Switch"
			 string symbol (repeat sexp)))
  :version "20"
  :group 'ps-print-printer)

(defcustom ps-print-region-function nil
  "*Specify a function to print the region on a PostScript printer.
See definition of `call-process-region' for calling conventions.  The fourth
and the sixth arguments are both nil."
  :type '(choice (const nil) function)
  :version "20"
  :group 'ps-print-printer)

(defcustom ps-manual-feed nil
  "*Non-nil means the printer will manually feed paper.

If it's nil, automatic feeding takes place."
  :type 'boolean
  :version "20"
  :group 'ps-print-printer)

(defcustom ps-end-with-control-d (and ps-windows-system t)
  "*Non-nil means insert C-d at end of PostScript file generated."
  :version "21.1"
  :type 'boolean
  :version "20"
  :group 'ps-print-printer)

;;; Page layout

;; All page dimensions are in PostScript points.

  :type '(repeat (list :tag "Paper Type"
		       (symbol :tag "Name")
		       (number :tag "Width")
		       (number :tag "Height")
		       (string :tag "Media")))
  :version "20"
  :group 'ps-print-page)

;;;###autoload
(defcustom ps-paper-type 'letter
  "*Specify the size of paper to format for.

			     (if (assq (widget-value wid)
				       ps-page-dimensions-database)
				 nil
			       (widget-put wid :error "Unknown paper size")
			       wid)))
  :version "20"
  :group 'ps-print-page)

(defcustom ps-warn-paper-type t
  "*Non-nil means give an error if paper size is not equal to `ps-paper-type'.

It's used when `ps-spool-config' is set to `setpagedevice'."
  :type 'boolean
  :version "20"
  :group 'ps-print-page)

(defcustom ps-landscape-mode nil
  "*Non-nil means print in landscape mode."
  :type 'boolean
  :version "20"
  :group 'ps-print-page)

(defcustom ps-print-upside-down nil
  "*Non-nil means print upside-down (that is, rotated by 180 degrees)."
  :type 'boolean

If nil, print all pages.

If a list, the lists element may be an integer or a cons cell (FROM . TO)
designating FROM page to TO page; any invalid element is ignored, that is, an
integer lesser than one or if FROM is greater than TO.

Otherwise, it's treated as nil.

After ps-print processing `ps-selected-pages' is set to nil.  But the
latest `ps-selected-pages' is saved in `ps-last-selected-pages' (which

		 (radio :tag "Page"
			(integer :tag "Number")
			(cons :tag "Range"
			      (integer :tag "From")
			      (integer :tag "To"))))
  :version "20"
  :group 'ps-print-page)

(defcustom ps-even-or-odd-pages nil
  "*Specify if it prints even/odd pages.

		 (const :tag "All Pages" nil)
		 (const :tag "Only Even Pages" even-page)
		 (const :tag "Only Odd Pages" odd-page)
		 (const :tag "Only Even Sheets" even-sheet)
		 (const :tag "Only Odd Sheets" odd-sheet))
  :version "20"
  :group 'ps-print-page)

(defcustom ps-print-control-characters 'control-8-bit
  "*Specify the printable form for control and 8-bit characters.
That is, instead of sending, for example, a ^D (\\004) to printer,

Any other value is treated as nil."
  :type '(choice :menu-tag "Control Char"
		 :tag "Control Char"
		 (const 8-bit)   (const control-8-bit)
		 (const control) (const :tag "nil" nil))
  :version "20"
  :group 'ps-print-miscellany)

(defcustom ps-n-up-printing 1
  "*Specify the number of pages per sheet paper."
  :type '(integer

		nil
	      (widget-put
	       wid :error
	       "Number of pages per sheet paper must be between 1 and 100.")
	      wid)))
  :version "20"
  :group 'ps-print-n-up)

(defcustom ps-n-up-margin (/ (* 72  1.0) 2.54) ; 1 cm
  "*Specify the margin in points between the sheet border and n-up printing."
  :type 'number
  :version "20"
  :group 'ps-print-n-up)

(defcustom ps-n-up-border-p t
  "*Non-nil means a border is drawn around each page."
  :type 'boolean
  :version "20"
  :group 'ps-print-n-up)

(defcustom ps-n-up-filling 'left-top
  "*Specify how page matrix is filled on each sheet of paper.

		 :tag "N-Up Filling"
		 (const left-top)  (const left-bottom)
		 (const right-top) (const right-bottom)
		 (const top-left)  (const bottom-left)
		 (const top-right) (const bottom-right))
  :version "20"
  :group 'ps-print-n-up)

(defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
  "*Specify the number of columns."
  :type 'number
  :version "20"
  :group 'ps-print-miscellany)

(defcustom ps-zebra-stripes nil
  "*Non-nil means print zebra stripes.
See also documentation for `ps-zebra-stripe-height' and `ps-zebra-color'."
  :type 'boolean
  :version "20"
  :group 'ps-print-zebra)

(defcustom ps-zebra-stripe-height 3
  "*Number of zebra stripe lines.
See also documentation for `ps-zebra-stripes' and `ps-zebra-color'."
  :type 'number
  :version "20"
  :group 'ps-print-zebra)

(defcustom ps-zebra-color 0.95
  "*Zebra stripe gray scale or RGB color.
See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."

		 (string :tag "Color Name" :value "gray95")
		 (list :tag "RGB Color" :value (0.95 0.95 0.95)
		       (number :tag "Red")
		       (number :tag "Green")
		       (number :tag "Blue")))
  :version "20"
  :group 'ps-print-zebra)

(defcustom ps-zebra-stripe-follow nil
  "*Specify how zebra stripes continue on next page.

		20 XXXXX +   20 XXXXXXXX +   18 XXXXXX +   18               +
		21       +   21 XXXXXXXX +
		22       +   22          +
		--------     -----------     ---------     ----------------

Any other value is treated as nil."
  :type '(choice :menu-tag "Zebra Stripe Follow"
		 :tag "Zebra Stripe Follow"
		 (const :tag "Always Restart" nil)
		 (const :tag "Continue on Next Page" follow)
		 (const :tag "Print Only Full Stripe" full)
		 (const :tag "Continue on Full Stripe" full-follow))
  :version "20"
  :group 'ps-print-zebra)

(defcustom ps-line-number nil
  "*Non-nil means print line number."
  :type 'boolean
  :version "20"
  :group 'ps-print-miscellany)

(defcustom ps-line-number-step 1
  "*Specify the interval that line number is printed.

Any other value is treated as `zebra'."
  :type '(choice :menu-tag "Line Number Step"
		 :tag "Line Number Step"
		 (integer :tag "Step Interval")
		 (const :tag "Synchronize Zebra" zebra))
  :version "20"
  :group 'ps-print-miscellany)

(defcustom ps-line-number-start 1
  "*Specify the starting point in the interval given by `ps-line-number-step'.

   * If `ps-line-number-step' is set to `zebra', must be between 1 and the
     value of `ps-zebra-strip-height' inclusive.  Use this combination if you
     wish that line number be relative to zebra stripes."
  :type '(integer :tag "Start Step Interval")
  :version "20"
  :group 'ps-print-miscellany)

(defcustom ps-print-background-image nil
  "*EPS image list to be printed on background.

FILENAME is a file name which contains an EPS image or some PostScript
programming like EPS.
FILENAME is ignored, if it doesn't exist or is read protected.

X and Y are relative positions on paper to put the image.
If X and Y are nil, the image is centered on paper.

XSCALE and YSCALE are scale factor to be applied to image before printing.
If XSCALE and YSCALE are nil, the original size is used.

ROTATION is the image rotation angle; if nil, the default is 0.

	   (repeat :tag "Pages" :inline t
		   (radio (integer :tag "Page")
			  (cons :tag "Range"
				(integer :tag "From")
				(integer :tag "To"))))))
  :version "20"
  :group 'ps-print-background)

(defcustom ps-print-background-text nil
  "*Text list to be printed on background.

	   (repeat :tag "Pages" :inline t
		   (radio (integer :tag "Page")
			  (cons :tag "Range"
				(integer :tag "From")
				(integer :tag "To"))))))
  :version "20"
  :group 'ps-print-background)

;;; Horizontal layout

;;  ------------------------------------------

;;  ------------------------------------------

(defcustom ps-left-margin   (/ (* 72  2.0) 2.54) ;   2 cm
  "*Left margin in points (1/72 inch)."
  :type 'number
  :version "20"
  :group 'ps-print-horizontal)

(defcustom ps-right-margin  (/ (* 72  2.0) 2.54) ;   2 cm
  "*Right margin in points (1/72 inch)."
  :type 'number
  :version "20"
  :group 'ps-print-horizontal)

(defcustom ps-inter-column  (/ (* 72  2.0) 2.54) ;   2 cm
  "*Horizontal space between columns in points (1/72 inch)."
  :type 'number
  :version "20"
  :group 'ps-print-horizontal)

;;; Vertical layout

;; |--------|

;; |--------|

(defcustom ps-bottom-margin (/ (* 72  1.5) 2.54) ; 1.5 cm
  "*Bottom margin in points (1/72 inch)."
  :type 'number
  :version "20"
  :group 'ps-print-vertical)

(defcustom ps-top-margin    (/ (* 72  1.5) 2.54) ; 1.5 cm
  "*Top margin in points (1/72 inch)."
  :type 'number
  :version "20"
  :group 'ps-print-vertical)

(defcustom ps-header-offset (/ (* 72  1.0) 2.54) ; 1.0 cm
  "*Vertical space in points (1/72 inch) between the main text and the header."
  :type 'number
  :version "20"
  :group 'ps-print-vertical)

(defcustom ps-header-line-pad 0.15
  "*Portion of a header title line height to insert.
The insertion is done between the header frame and the text it contains,
both in the vertical and horizontal directions."
  :type 'number
  :version "20"
  :group 'ps-print-vertical)

(defcustom ps-footer-offset (/ (* 72  1.0) 2.54) ; 1.0 cm
  "*Vertical space in points (1/72 inch) between the main text and the footer."
  :type 'number
  :version "20"
  :group 'ps-print-vertical)

(defcustom ps-footer-line-pad 0.15
  "*Portion of a footer title line height to insert.
The insertion is done between the footer frame and the text it contains,
both in the vertical and horizontal directions."
  :type 'number
  :version "20"
  :group 'ps-print-vertical)

;;; Header/Footer setup

(defcustom ps-print-header t
  "*Non-nil means print a header at the top of each page.
By default, the header displays the buffer name, page number, and, if the
buffer is visiting a file, the file's directory.  Headers are customizable by
changing variables `ps-left-header' and `ps-right-header'."
  :type 'boolean
  :version "20"
  :group 'ps-print-headers)

(defcustom ps-print-header-frame t
  "*Non-nil means draw a gaudy frame around the header."
  :type 'boolean
  :version "20"
  :group 'ps-print-headers)

(defcustom ps-header-frame-alist
  '((fore-color   . 0.0)
    (back-color   . 0.9)

				(string :tag "Color Name" :value "black")
				(list :tag "RGB Color" :value (0.0 0.0 0.0)
				      (number :tag "Red")
				      (number :tag "Green")
				      (number :tag "Blue"))))))
  :version "20"
  :group 'ps-print-headers)

(defcustom ps-header-lines 2
  "*Number of lines to display in page header, when generating PostScript."
  :type 'integer
  :version "20"
  :group 'ps-print-headers)

(defcustom ps-print-footer nil
  "*Non-nil means print a footer at the bottom of each page.
By default, the footer displays page number.
Footers are customizable by changing variables `ps-left-footer' and
`ps-right-footer'."
  :type 'boolean
  :version "21.1"
  :group 'ps-print-headers)

(defcustom ps-print-footer-frame t
  "*Non-nil means draw a gaudy frame around the footer."
  :type 'boolean
  :version "21.1"
  :group 'ps-print-headers)

(defcustom ps-footer-frame-alist
  '((fore-color   . 0.0)
    (back-color   . 0.9)

Don't change this alist directly, instead use customization, or `ps-value',
`ps-get', `ps-put' and `ps-del' functions (see them for documentation).

See also `ps-header-frame-alist' for documentation."
  :type '(repeat
	  (choice :menu-tag "Header Frame Element"
		  :tag ""
		  (cons :tag "Foreground Color" :format "%v"
			(const :format "" fore-color)

				(string :tag "Color Name" :value "black")
				(list :tag "RGB Color" :value (0.0 0.0 0.0)
				      (number :tag "Red")
				      (number :tag "Green")
				      (number :tag "Blue"))))))
  :version "21.1"
  :group 'ps-print-headers)

(defcustom ps-footer-lines 2
  "*Number of lines to display in page footer, when generating PostScript."
  :type 'integer
  :version "21.1"
  :group 'ps-print-headers)

(defcustom ps-print-only-one-header nil
  "*Non-nil means print only one header/footer at the top/bottom of each page.
This is useful when printing more than one column, so it is possible to have
only one header/footer over all columns or one header/footer per column.
See also `ps-print-header' and `ps-print-footer'."
  :type 'boolean
  :version "20"
  :group 'ps-print-headers)

(defcustom ps-switch-header 'duplex
  "*Specify if headers/footers are switched or not.

  :type '(choice :menu-tag "Switch Header/Footer"
		 :tag "Switch Header/Footer"
		 (const :tag "Never Switch" nil)
		 (const :tag "Always Switch" t)
		 (const :tag "Switch When Duplexing" duplex))
  :version "20"
  :group 'ps-print-headers)

(defcustom ps-show-n-of-n t
  "*Non-nil means show page numbers as N/M, meaning page N of M.
NOTE: page numbers are displayed as part of headers,
      see variable `ps-print-header'."
  :type 'boolean
  :version "20"
  :group 'ps-print-headers)

(defcustom ps-spool-config
  (if ps-windows-system
      nil

	 the printed file isn't OK, set `ps-spool-config' to nil."
  :type '(choice :menu-tag "Spool Config"
		 :tag "Spool Config"
		 (const lpr-switches) (const setpagedevice)
		 (const :tag "nil" nil))
  :version "20"
  :group 'ps-print-headers)

(defcustom ps-spool-duplex nil		; Not many people have duplex printers,
					; so default to nil.
  "*Non-nil generates PostScript for a two-sided printer.

reversed on duplex printers so that the page numbers fall to the left on
even-numbered pages.

See also `ps-spool-tumble'."
  :type 'boolean
  :version "20"
  :group 'ps-print-headers)

(defcustom ps-spool-tumble nil
  "*Specify how the page images on opposite sides of a sheet are oriented.
If `ps-spool-tumble' is nil, produces output suitable for binding on the left
or right.  If `ps-spool-tumble' is non-nil, produces output suitable for
binding at the top or bottom.

It has effect only when `ps-spool-duplex' is non-nil."
  :type 'boolean
  :version "20"
  :group 'ps-print-headers)

;;; Fonts

(defcustom ps-font-info-database

     (fonts (normal . "Zapf-Dingbats"))
     (size . 10.0)
     (line-height . 9.63)
     (space-width . 2.78)
     (avg-char-width . 2.78))
    (ZapfChancery-MediumItalic
     (fonts (normal . "ZapfChancery-MediumItalic"))
     (size . 10.0)
     (line-height . 11.45)
     (space-width . 2.2)
     (avg-char-width . 4.10811))
    ;; We keep this wrong entry name (but with correct font name) for
    ;; backward compatibility.
    (Zapf-Chancery-MediumItalic
     (fonts (normal . "ZapfChancery-MediumItalic"))
     (size . 10.0)
     (line-height . 11.45)
     (space-width . 2.2)
     (avg-char-width . 4.10811))
    )

		      (const :format "" space-width)
		      (number :tag "Space Width"))
		(cons :format "%v"
		      (const :format "" avg-char-width)
		      (number :tag "Average Character Width"))))
  :version "20"
  :group 'ps-print-font)

(defcustom ps-font-family 'Courier
  "*Font family name for ordinary text, when generating PostScript."
  :type 'symbol
  :version "20"
  :group 'ps-print-font)

(defcustom ps-font-size   '(7 . 8.5)
  "*Font size, in points, for ordinary text, when generating PostScript."
  :type '(choice :menu-tag "Ordinary Text Font Size"
		 :tag "Ordinary Text Font Size"
		 (number :tag "Text Size")
		 (cons :tag "Landscape/Portrait"
		       (number :tag "Landscape Text Size")
		       (number :tag "Portrait Text Size")))
  :version "20"
  :group 'ps-print-font)

(defcustom ps-header-font-family      'Helvetica
  "*Font family name for text in the header, when generating PostScript."
  :type 'symbol
  :version "20"
  :group 'ps-print-font)

(defcustom ps-header-font-size       '(10 . 12)
  "*Font size, in points, for text in the header, when generating PostScript."
  :type '(choice :menu-tag "Header Font Size"
		 :tag "Header Font Size"
		 (number :tag "Header Size")
		 (cons :tag "Landscape/Portrait"
		       (number :tag "Landscape Header Size")
		       (number :tag "Portrait Header Size")))
  :version "20"
  :group 'ps-print-font)

(defcustom ps-header-title-font-size '(12 . 14)
  "*Font size, in points, for the top line of text in header, in PostScript."
  :type '(choice :menu-tag "Header Title Font Size"
		 :tag "Header Title Font Size"
		 (number :tag "Header Title Size")
		 (cons :tag "Landscape/Portrait"
		       (number :tag "Landscape Header Title Size")
		       (number :tag "Portrait Header Title Size")))
  :version "20"
  :group 'ps-print-font)

(defcustom ps-footer-font-family      'Helvetica
  "*Font family name for text in the footer, when generating PostScript."
  :type 'symbol
  :version "21.1"
  :group 'ps-print-font)

(defcustom ps-footer-font-size       '(10 . 12)
  "*Font size, in points, for text in the footer, when generating PostScript."
  :type '(choice :menu-tag "Footer Font Size"
		 :tag "Footer Font Size"
		 (number :tag "Footer Size")
		 (cons :tag "Landscape/Portrait"
		       (number :tag "Landscape Footer Size")
		       (number :tag "Portrait Footer Size")))
  :version "21.1"
  :group 'ps-print-font)

(defcustom ps-line-number-color      "black"
  "*Specify color for line-number, when generating PostScript."
  :type '(choice :menu-tag "Line Number Color"

  :group 'ps-print-miscellany)

(defcustom ps-line-number-font      "Times-Italic"
  "*Font for line-number, when generating PostScript."
  :type 'string
  :version "20"
  :group 'ps-print-font
  :group 'ps-print-miscellany)

(defcustom ps-line-number-font-size 6
  "*Font size, in points, for line number, when generating PostScript."

		 :tag "Line Number Font Size"
		 (number :tag "Font Size")
		 (cons :tag "Landscape/Portrait"
		       (number :tag "Landscape Font Size")
		       (number :tag "Portrait Font Size")))
  :version "20"
  :group 'ps-print-font
  :group 'ps-print-miscellany)

;;; Colors

  :type '(choice :menu-tag "Print Color"
		 :tag "Print Color"
		 (const :tag "Do NOT Print Color" nil)
		 (const :tag "Print Always Color" t)
		 (const :tag "Print Black/White Color" black-white))
  :version "20"
  :group 'ps-print-color)

(defcustom ps-default-fg '(0.0 0.0 0.0) ; black
  "*RGB values of the default foreground color.  Defaults to black.

The `ps-default-fg' variable contains the default foreground color used by
ps-print, that is, if there is a face in a text that doesn't have a foreground
color, the `ps-default-fg' color should be used.

Valid values are:

   t		The foreground color of Emacs session will be used.

   NUMBER	It's a real value between 0.0 (black) and 1.0 (white) that
		indicate the gray color.

   COLOR-NAME	It's a string which contains the color name.  For example:
		\"yellow\".

   LIST		It's a list of RGB values, that is a list of three real values
		of the form:

		  (RED, GREEN, BLUE)

		Where RED, GREEN and BLUE are reals between 0.0 (no color) and
		1.0 (full color).

Any other value is ignored and black will be used.

It's used only when `ps-print-color-p' is non-nil."
  :type '(choice :menu-tag "Default Foreground Gray/Color"
		 :tag "Default Foreground Gray/Color"
		 (const :tag "Session Foreground" t)
		 (number :tag "Gray Scale" :value 0.0)
		 (string :tag "Color Name" :value "black")
		 (list :tag "RGB Color" :value (0.0 0.0 0.0)
		       (number :tag "Red")
		       (number :tag "Green")
		       (number :tag "Blue")))
  :version "20"
  :group 'ps-print-color)

(defcustom ps-default-bg '(1.0 1.0 1.0) ; white
  "*RGB values of the default background color.  Defaults to white.

The `ps-default-bg' variable contains the default background color used by
ps-print, that is, if there is a face in a text that doesn't have a background
color, the `ps-default-bg' color should be used.

Valid values are:

   t		The background color of Emacs session will be used.

   NUMBER	It's a real value between 0.0 (black) and 1.0 (white) that
		indicate the gray color.

   COLOR-NAME	It's a string which contains the color name.  For example:
		\"yellow\".

   LIST		It's a list of RGB values, that is a list of three real values
		of the form:

		  (RED, GREEN, BLUE)

		Where RED, GREEN and BLUE are reals between 0.0 (no color) and
		1.0 (full color).

Any other value is ignored and white will be used.

It's used only when `ps-print-color-p' is non-nil.

See also `ps-use-face-background'."
  :type '(choice :menu-tag "Default Background Gray/Color"
		 :tag "Default Background Gray/Color"
		 (const :tag "Session Background" t)
		 (number :tag "Gray Scale" :value 1.0)
		 (string :tag "Color Name" :value "white")
		 (list :tag "RGB Color" :value (1.0 1.0 1.0)
		       (number :tag "Red")
		       (number :tag "Green")
		       (number :tag "Blue")))
  :version "20"
  :group 'ps-print-color)

(defcustom ps-auto-font-detect t
  "*Non-nil means automatically detect bold/italic/underline face attributes.
If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces', and
`ps-underlined-faces'."
  :type 'boolean
  :version "20"
  :group 'ps-print-font)

(defcustom ps-black-white-faces
  '((font-lock-builtin-face       "black"  nil bold       )
    (font-lock-comment-face       "gray20" nil      italic)

				(const strikeout)
				(const overline)
				(const shadow)
				(const box)
				(const outline)))))
  :version "20"
  :group 'ps-print-face)

(defcustom ps-bold-faces
  (unless ps-print-color-p
    '(font-lock-function-name-face

      font-lock-keyword-face
      font-lock-warning-face))
  "*A list of the \(non-bold\) faces that should be printed in bold font.
This applies to generating PostScript."
  :type '(repeat face)
  :version "20"
  :group 'ps-print-face)

(defcustom ps-italic-faces
  (unless ps-print-color-p
    '(font-lock-variable-name-face

      font-lock-comment-face
      font-lock-warning-face))
  "*A list of the \(non-italic\) faces that should be printed in italic font.
This applies to generating PostScript."
  :type '(repeat face)
  :version "20"
  :group 'ps-print-face)

(defcustom ps-underlined-faces
  (unless ps-print-color-p
    '(font-lock-function-name-face
      font-lock-constant-face
      font-lock-warning-face))
  "*A list of the \(non-underlined\) faces that should be printed underlined.
This applies to generating PostScript."
  :type '(repeat face)
  :version "20"
  :group 'ps-print-face)

(defcustom ps-use-face-background nil
  "*Specify if face background should be used.

		 (const :tag "Always Use Face Background" t)
		 (const :tag "Never Use Face Background" nil)
		 (repeat :menu-tag "Face Background List"
			 :tag "Face Background List"
			 face))
  :version "20"
  :group 'ps-print-face)

(defcustom ps-left-header
  (list 'ps-get-buffer-name 'ps-header-dirpart)
  "*The items to display (each on a line) on the left part of the page header.

delimiters '(' and ')'.

For symbols with bound functions, the function is called and should return a
string to be inserted into the array.  For symbols with bound values, the value
should be a string to be inserted into the array.  In either case, function or
variable, the string value has PostScript string delimiters added to it.

If symbols are unbounded, they are silently ignored."
  :type '(repeat (choice :menu-tag "Left Header"
			 :tag "Left Header"
			 string symbol))
  :version "20"
  :group 'ps-print-headers)

(defcustom ps-right-header
  (list "/pagenumberstring load"
	'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)

   `ps-time-stamp-hh:mm:ss'		Return time as \"17:28:31\".

   `ps-time-stamp-mon-dd-yyyy'		Return date as \"Jun 18 2001\".

   `ps-time-stamp-yyyy-mm-dd'		Return date as \"2001-06-18\" (ISO
					date).

   `ps-time-stamp-iso8601'		Alias for `ps-time-stamp-yyyy-mm-dd'.

You can also create your own time stamp function by using `format-time-string'
\(which see)."
  :type '(repeat (choice :menu-tag "Right Header"
			 :tag "Right Header"
			 string symbol))
  :version "20"
  :group 'ps-print-headers)

(defcustom ps-left-footer
  (list 'ps-get-buffer-name 'ps-header-dirpart)
  "*The items to display (each on a line) on the left part of the page footer.

')'.

For symbols with bound functions, the function is called and should return a
string to be inserted into the array.  For symbols with bound values, the value
should be a string to be inserted into the array.  In either case, function or
variable, the string value has PostScript string delimiters added to it.

If symbols are unbounded, they are silently ignored."
  :type '(repeat (choice :menu-tag "Left Footer"
			 :tag "Left Footer"
			 string symbol))
  :version "21.1"
  :group 'ps-print-headers)

(defcustom ps-right-footer
  (list "/pagenumberstring load"
	'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)

   `ps-time-stamp-hh:mm:ss'		Return time as \"17:28:31\".

   `ps-time-stamp-mon-dd-yyyy'		Return date as \"Jun 18 2001\".

   `ps-time-stamp-yyyy-mm-dd'		Return date as \"2001-06-18\" (ISO
					date).

   `ps-time-stamp-iso8601'		Alias for `ps-time-stamp-yyyy-mm-dd'.

You can also create your own time stamp function by using `format-time-string'
\(which see)."
  :type '(repeat (choice :menu-tag "Right Footer"
			 :tag "Right Footer"
			 string symbol))
  :version "21.1"
  :group 'ps-print-headers)

(defcustom ps-razzle-dazzle t
  "*Non-nil means report progress while formatting buffer."
  :type 'boolean
  :version "20"
  :group 'ps-print-miscellany)

(defcustom ps-adobe-tag "%!PS-Adobe-3.0\n"
  "*Contains the header line identifying the output as PostScript.
By default, `ps-adobe-tag' contains the standard identifier.  Some printers
require slightly different versions of this line."
  :type 'string
  :version "20"
  :group 'ps-print-miscellany)

(defcustom ps-build-face-reference t
  "*Non-nil means build the reference face lists.

You should set this value back to t after you change the attributes of any
face, or create new faces.  Most users shouldn't have to worry about its
setting, though."
  :type 'boolean
  :version "20"
  :group 'ps-print-face)

(defcustom ps-always-build-face-reference nil
  "*Non-nil means always rebuild the reference face lists.

If this variable is non-nil, ps-print will rebuild its internal reference lists
of bold and italic faces *every* time one of the ...-with-faces commands is
called.  Most users shouldn't need to set this variable."
  :type 'boolean
  :version "20"
  :group 'ps-print-face)

(defcustom ps-banner-page-when-duplexing nil
  "*Non-nil means the very first page is skipped.
It's like the very first character of buffer (or region) is ^L (\\014)."
  :type 'boolean
  :version "20"
  :group 'ps-print-headers)

(defcustom ps-postscript-code-directory
  (or (if (featurep 'xemacs)
	  (cond ((fboundp 'locate-data-directory) ; xemacs
		 (locate-data-directory "ps-print"))
		((boundp 'data-directory) ; xemacs
		 data-directory)
		(t			; don't know what to do
		 nil))
	data-directory)			; emacs
      (error "`ps-postscript-code-directory' isn't set properly"))
  "*Directory where it's located the PostScript prologue file used by ps-print.
By default, this directory is the same as in the variable `data-directory'."
  :type 'directory
  :version "20"
  :group 'ps-print-miscellany)

(defcustom ps-line-spacing 0
  "*Specify line spacing, in points, for ordinary text.

  (let (ps-prefix-quote)
    (mapconcat
     #'ps-print-quote
     (list
      (concat "\n;;; ps-print version " ps-print-version "\n")
      ";; internal vars"
      (ps-comment-string "emacs-version      " emacs-version)
      (ps-comment-string "ps-print-emacs-type" ps-print-emacs-type)
      (ps-comment-string "ps-windows-system  " ps-windows-system)
      (ps-comment-string "ps-lp-system       " ps-lp-system)
      nil
      '(25 . ps-print-color-p)
      '(25 . ps-lpr-command)
      '(25 . ps-lpr-switches)
      '(25 . ps-printer-name)
      '(25 . ps-printer-name-option)

		  "      "
		(setq ps-prefix-quote t)
		"(setq ")
	      key
	      (if (> col len)
		  (make-string (- col len) ?\s)
		" ")
	      (ps-value-string val))))
   (t "")
   ))


(defun ps-value-string (val)
  "Return a string representation of VAL.  Used by `ps-print-quote'."
  (cond ((null val)
	 "nil")
	((eq val t)
	 "t")
	((or (symbolp val) (listp val))
	 (format "'%S" val))
	(t
	 (format "%S" val))))


(defun ps-comment-string (str value)
  "Return a comment string like \";; STR = VALUE\"."
  (format ";; %s = %s" str (ps-value-string value)))


(defun ps-value (alist-sym key)
  "Return value from association list ALIST-SYM which car is `eq' to KEY."
  (cdr (assq key (symbol-value alist-sym))))

(defun ps-time-stamp-mon-dd-yyyy ()
  "Return date as \"Jun 18 2001\"."
  (format-time-string "%b %d %Y"))


(defun ps-time-stamp-yyyy-mm-dd ()
  "Return date as \"2001-06-18\" (ISO date)."
  (format-time-string "%Y-%m-%d"))


;; Alias for `ps-time-stamp-yyyy-mm-dd' (which see).
(defalias 'ps-time-stamp-iso8601 'ps-time-stamp-yyyy-mm-dd)


(defun ps-time-stamp-hh:mm:ss ()
  "Return time as \"17:28:31\"."
  (format-time-string "%T"))


(and (featurep 'xemacs)
     ;; XEmacs change: Need to check for emacs-major-version too.
     (or (< emacs-major-version 19)
	 (and (= emacs-major-version 19) (< emacs-minor-version 12)))
     (setq ps-print-color-p nil))


;; Return t if the device (which can be changed during an emacs session)
;; can handle colors.
;; This function is not yet implemented for GNU emacs.
(cond ((and (featurep 'xemacs)
	    ;; XEmacs change: Need to check for emacs-major-version too.
	    (or (> emacs-major-version 19)
		(and (= emacs-major-version 19)
		     (>= emacs-minor-version 12)))) ; xemacs >= 19.12
       (defun ps-color-device ()
	 (eq (ps-x-device-class) 'color)))

      (t				; emacs
       (defun ps-color-device ()
	 (if (fboundp 'color-values)
	     (ps-e-color-values "Green")
	   t))))


(defun ps-mapper (extent list)
  (nconc list
	 (list (list (ps-x-extent-start-position extent) 'push extent)
	       (list (ps-x-extent-end-position extent) 'pull extent)))
  nil)

(defun ps-extent-sorter (a b)
  (< (ps-x-extent-priority a) (ps-x-extent-priority b)))

(defun ps-xemacs-face-kind-p (face kind kind-regex)
  (let* ((frame-font (or (ps-x-face-font-instance face)
			 (ps-x-face-font-instance 'default)))
	 (kind-cons
	  (and frame-font
	       (assq kind
		     (ps-x-font-instance-properties frame-font))))
	 (kind-spec (cdr-safe kind-cons))
	 (case-fold-search t))
    (and kind-spec (string-match kind-regex kind-spec))))

(cond ((featurep 'xemacs)		; xemacs

       ;; to avoid XEmacs compilation gripes
       (defvar coding-system-for-write   nil)
       (defvar coding-system-for-read    nil)
       (defvar buffer-file-coding-system nil)

       (and (fboundp 'find-coding-system)
	    (or (ps-x-find-coding-system 'raw-text-unix)
		(ps-x-copy-coding-system 'no-conversion-unix 'raw-text-unix)))

       (defun ps-color-values (x-color)
	 (let ((color (ps-xemacs-color-name x-color)))
	   (cond
	    ((fboundp 'x-color-values)
	     (ps-e-x-color-values color))
	    ((and (fboundp 'color-instance-rgb-components)
		  (ps-color-device))
	     (ps-x-color-instance-rgb-components
	      (if (ps-x-color-instance-p x-color)
		  x-color
		(ps-x-make-color-instance color))))
	    (t
	     (error "No available function to determine X color values")))))

       (defun ps-face-bold-p (face)
	 (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
	     (memq face ps-bold-faces))) ; Kludge-compatible

       (defun ps-face-italic-p (face)
	 (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o")
	     (ps-xemacs-face-kind-p face 'SLANT "i\\|o")
	     (memq face ps-italic-faces))) ; Kludge-compatible
       )

      (t				; emacs

       (defun ps-color-values (x-color)
	 (cond
	  ((fboundp 'color-values)
	   (ps-e-color-values x-color))
	  ((fboundp 'x-color-values)
	   (ps-e-x-color-values x-color))
	  (t
	   (error "No available function to determine X color values"))))

       (defun ps-face-bold-p (face)
	 (or (ps-e-face-bold-p face)
	     (memq face ps-bold-faces)))

       (defun ps-face-italic-p (face)
	 (or (ps-e-face-italic-p face)
	     (memq face ps-italic-faces)))
       ))


(defvar ps-print-color-scale 1.0)

(defun ps-color-scale (color)

(defvar ps-background-text-count 0)
(defvar ps-background-image-count 0)

(defvar ps-current-font 0)
(defvar ps-default-foreground nil)
(defvar ps-default-background nil)
(defvar ps-default-color nil)
(defvar ps-current-color nil)
(defvar ps-current-bg nil)

(defvar ps-zebra-stripe-full-p nil)
(defvar ps-razchunk 0)

(defvar ps-color-p nil)
(defvar ps-color-format
  (if (featurep 'xemacs)
      ;; XEmacs will have to make do with %s (princ) for floats.
      "%s %s %s"

    ;; Emacs understands the %f format; we'll use it to limit color RGB
    ;; values to three decimals to cut down some on the size of the
    ;; PostScript output.
    "%0.3f %0.3f %0.3f"))

;; These values determine how much print-height to deduct when headers/footers
;; are turned on.  This is a pretty clumsy way of handling it, but it'll do for
;; now.

  "Extend face in ALIST-SYM.

If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
with face extension in ALIST-SYM; otherwise, overrides.

If optional ALIST-SYM is nil, `ps-print-face-extension-alist' is used;
otherwise, it should be an alist symbol.

The elements in FACE-EXTENSION-LIST are like those for `ps-extend-face'.

See `ps-extend-face' for documentation."
  (while face-extension-list
    (ps-extend-face (car face-extension-list) merge-p alist-sym)
    (setq face-extension-list (cdr face-extension-list))))

  "Extend face in ALIST-SYM.

If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
with face extensions in ALIST-SYM; otherwise, overrides.

If optional ALIST-SYM is nil, `ps-print-face-extension-alist' is used;
otherwise, it should be an alist symbol.

The elements of FACE-EXTENSION list have the form:

   (FACE-NAME FOREGROUND BACKGROUND EXTENSION...)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal functions and variables


(defun ps-message-log-max ()
  (and (not (string= (buffer-name) "*Messages*"))
       (boundp 'message-log-max)
       message-log-max))


(defvar ps-print-hook nil)
(defvar ps-print-begin-sheet-hook nil)
(defvar ps-print-begin-page-hook nil)
(defvar ps-print-begin-column-hook nil)

  (ps-spool-without-faces from to region-p)
  (ps-do-despool filename))


(defun ps-spool-without-faces (from to &optional region-p)
  (let ((message-log-max (ps-message-log-max)))	; to print *Messages* buffer
    (run-hooks 'ps-print-hook)
    (ps-printing-region region-p from to)
    (ps-generate (current-buffer) from to 'ps-generate-postscript)))


(defun ps-print-with-faces (from to &optional filename region-p)
  (ps-spool-with-faces from to region-p)
  (ps-do-despool filename))


(defun ps-spool-with-faces (from to &optional region-p)
  (let ((message-log-max (ps-message-log-max)))	; to print *Messages* buffer
    (run-hooks 'ps-print-hook)
    (ps-printing-region region-p from to)
    (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces)))


(defun ps-count-lines-preprint (from to)
  (or (and from to)
      (error "The mark is not set now"))
  (let ((message-log-max (ps-message-log-max)))	; to count lines of *Messages*
    (list (count-lines from to))))


(defun ps-count-lines (from to)
  (+ (count-lines from to)
     (save-excursion
       (goto-char to)
       (if (= (current-column) 0) 1 0))))


(defvar ps-printing-region nil
  "Variable used to indicate the region that ps-print is printing.
It is a cons, the car of which is the line number where the region begins, and
its cdr is the total number of lines in the buffer.  Formatting functions can
use this information to print the original line number (and not the number of
lines printed), and to indicate in the header that the printout is of a partial
file.")

(defvar ps-printing-region-p nil
  "Non-nil means ps-print is printing a region.")


(defun ps-printing-region (region-p from to)
  (setq ps-printing-region-p region-p
	ps-printing-region
	(cons (if region-p
		  (ps-count-lines (point-min) (min from to))
		1)
	      (ps-count-lines (point-min) (point-max)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

       (or (numberp prefix-arg)
	   (listp prefix-arg))
       (let* ((name   (concat (file-name-nondirectory (or (buffer-file-name)
							  (buffer-name)))
			      ".ps"))
	      (prompt (format "Save PostScript to file (default %s): " name))
	      (res    (read-file-name prompt default-directory name nil)))
	 (while (cond ((file-directory-p res)
		       (ding)
		       (setq prompt "It's a directory"))
		      ((not (file-writable-p res))

(defun ps-insert-file (fname)
  (ps-flush-output)
  (save-excursion
    (set-buffer ps-spool-buffer)
    (goto-char (point-max))
    (insert-file-contents fname)))

;; These functions are used in `ps-mule' to get charset of header and footer.
;; To avoid unnecessary calls to functions in `ps-left-header',
;; `ps-right-header', `ps-left-footer' and `ps-right-footer'.

(defun ps-generate-string-list (content)
  (let (str)
    (while content
      (setq str (cons (cond
		       ;; string
		       ((stringp (car content))
			(car content))
		       ;; function symbol
		       ((functionp (car content))
			(concat "(" (funcall (car content)) ")"))
		       ;; variable symbol
		       ((and (symbolp (car content)) (boundp (car content)))
			(concat "(" (symbol-value (car content)) ")"))
		       ;; otherwise, empty string
		       (t
			""))
		      str)
	    content (cdr content)))
    (nreverse str)))

(defvar ps-lh-cache nil)
(defvar ps-rh-cache nil)
(defvar ps-lf-cache nil)
(defvar ps-rf-cache nil)

(defun ps-header-footer-string ()
  (and ps-print-header
       (setq ps-lh-cache (ps-generate-string-list ps-left-header)
	     ps-rh-cache (ps-generate-string-list ps-right-header)))
  (and ps-print-footer
       (setq ps-lf-cache (ps-generate-string-list ps-left-footer)
	     ps-rf-cache (ps-generate-string-list ps-right-footer)))
  (append ps-lh-cache ps-rh-cache ps-lf-cache ps-rf-cache))

;; These functions insert the arrays that define the contents of the headers.

(defun ps-generate-header-line (fonttag &optional content)
  (ps-output " [" fonttag " ")

   ((stringp content)
    (ps-output (ps-mule-encode-header-string content fonttag)))

   ;; Functions are called -- they should return strings; they will be inserted
   ;; as strings and the PS string delimiters added.
   ((functionp content)
    (ps-output-string (ps-mule-encode-header-string (funcall content)
						    fonttag)))

   ;; Variables will have their contents inserted.  They should contain
   ;; strings, and will be inserted as strings.

;; Emacs understands the %f format; we'll use it to limit color RGB values
;; to three decimals to cut down some on the size of the PostScript output.
;; XEmacs will have to make do with %s (princ) for floats.

(defvar ps-float-format (if (featurep 'xemacs)
			    "%s "	; xemacs
			  "%0.3f "))	; emacs


(defun ps-float-format (value &optional default)
  (let ((literal (or value default)))
    (cond ((null literal)

			     "PrintPageWidth 2 div")
	    (ps-float-format (nth 2 image) ; y position
			     "PrintHeight 2 div BottomMargin add")
	    "\nBeginBackImage\n")
	   (ps-insert-file image-file)
	   ;; coordinate adjustment to center image
	   ;; around x and y position
	   (let ((box (ps-get-boundingbox)))
	     (save-excursion
	       (set-buffer ps-spool-buffer)
	       (save-excursion

    (and ps-n-up-on (setq tumble (not tumble)))
    (ps-output
     ps-adobe-tag
     "%%Title: " (buffer-name)		; Take job name from name of
					; first buffer printed
     "\n%%Creator: ps-print v" ps-print-version
     "\n%%For: " (user-full-name)
     "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
     "\n%%Orientation: "
     (if ps-landscape-mode "Landscape" "Portrait")
     "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
     (mapconcat 'identity
		(ps-remove-duplicates
		 (append (ps-fonts 'ps-font-for-text)
			 (list (ps-font 'ps-font-for-header 'normal)
			       (ps-font 'ps-font-for-header 'bold)
			       (ps-font 'ps-font-for-footer 'normal)
			       (ps-font 'ps-font-for-footer 'bold))))
		"\n%%+ font ")
     "\n%%DocumentSuppliedResources: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0"
     "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
     (format " %d" (round (ps-page-dimensions-get-width dimensions)))
     (format " %d" (round (ps-page-dimensions-get-height dimensions)))
     " 0 () ()\n%%PageOrder: Ascend\n%%Pages: (atend)\n%%Requirements:"
     (if ps-spool-duplex

	       (format "/ErrorMessage  %s def\n\n"
		       (or (cdr (assoc ps-error-handler-message
				       ps-error-handler-alist))
			   1))		; send to paper
	       ps-print-prologue-0
	       "\n%%BeginResource: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0\n\n")

    (ps-insert-string ps-user-defined-prologue)

    (ps-output "\n%%EndResource\n\n")

    (ps-output-boolean "LandscapeMode      "
		       (or ps-landscape-mode
			   (eq (ps-n-up-landscape n-up) 'pag)))
    (ps-output-boolean "UpsideDown         " ps-print-upside-down)

	       (format "def\n/ZebraHeight      %d def\n"
		       ps-zebra-stripe-height)
	       "/ZebraColor       "
	       (ps-format-color ps-zebra-color 0.95)
	       "def\n/BackgroundColor  "
	       (ps-format-color ps-default-background 1.0)
	       "def\n/UseSetpagedevice "
	       (if (eq ps-spool-config 'setpagedevice)
		   "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
		 "false")
	       " def\n\n/PageWidth "

    (ps-background-text)
    (ps-background-image)
    (setq ps-background-all-pages (nreverse ps-background-all-pages)
	  ps-background-pages (nreverse ps-background-pages))

    (ps-output "\n" ps-print-prologue-1
	       "\n/printGlobalBackground{\n")
    (mapcar 'ps-output ps-background-all-pages)
    (ps-output
     "}def\n/printLocalBackground{\n}def\n"
     "\n%%EndProlog\n\n%%BeginSetup\n"
     "\n%%IncludeResource: font Times-Roman"
     "\n%%IncludeResource: font Times-Italic"
     "\n%%IncludeResource: font "
     (mapconcat 'identity
		(ps-remove-duplicates
		 (append (ps-fonts 'ps-font-for-text)
			 (list (ps-font 'ps-font-for-header 'normal)
			       (ps-font 'ps-font-for-header 'bold)
			       (ps-font 'ps-font-for-footer 'normal)
			       (ps-font 'ps-font-for-footer 'bold))))
		"\n%%IncludeResource: font ")
     ;; Header/line number fonts
     (format "\n/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
	     ps-header-title-font-size-internal
	     (ps-font 'ps-font-for-header 'bold))
     (format "/h1 %s(%s)cvn DefFont\n"	; /h1 12/Helvetica DefFont
	     ps-header-font-size-internal
	     (ps-font 'ps-font-for-header 'normal))
     (format "/L0 %s(%s)cvn DefFont\n"	; /L0 6/Times-Italic DefFont
	     (ps-get-font-size 'ps-line-number-font-size)
	     ps-line-number-font)
     (format "/H0 %s(%s)cvn DefFont\n"	; /H0 12/Helvetica DefFont
	     ps-footer-font-size-internal
	     (ps-font 'ps-font-for-footer 'normal))
     "\n\n% ---- These lines must be kept together because...

/h0 F
/HeaderTitleLineHeight FontHeight def

/h1 F

    (let ((font-entry (cdr (assq ps-font-family ps-font-info-database))))
      (ps-output (format "/SpaceWidthRatio %f def\n"
			 (/ (ps-lookup 'space-width) (ps-lookup 'size)))))

    (unless (eq ps-spool-config 'lpr-switches)
      (ps-output "\n%%BeginFeature: *Duplex "
		 (ps-boolean-capitalized ps-spool-duplex)
		 " *Tumble "
		 (ps-boolean-capitalized tumble)

(defun ps-get-font-size (font-sym)
  (ps-get-size (symbol-value font-sym) "font size" font-sym))


(defun ps-rgb-color (color default)
  (cond ((and color (listp color) (= (length color) 3)
	      (let ((cl color)
		    (ok t) e)
		(while (and ok cl)
		  (setq e  (car cl)
			cl (cdr cl)
			ok (and (floatp e) (<= 0.0 e) (<= e 1.0))))
		ok))
	 color)
	((and (floatp color) (<= 0.0 color) (<= color 1.0))
	 (list color color color))
	((stringp color) (ps-color-scale color))
	(t (list default default default))
	))


(defun ps-begin-job ()

	      ((eq ps-print-control-characters 'control-8-bit)
	       (string-as-unibyte "[\000-\037\177-\237]"))
	      ((eq ps-print-control-characters 'control)
	       "[\000-\037\177]")
	      (t "[\t\n\f]"))
	ps-default-background (ps-rgb-color
			       (if (eq ps-default-bg t)
				   (ps-face-background-name 'default)
				 ps-default-bg)
			       1.0)
	ps-default-foreground (ps-rgb-color
			       (if (eq ps-default-fg t)
				   (ps-face-foreground-name 'default)
				 ps-default-fg)
			       0.0)

	ps-color-p           (and ps-print-color-p (ps-color-device))
	ps-print-color-scale (if ps-color-p
				 (float (car (ps-color-values "white")))
			       1.0))
  ;; initialize page dimensions
  (ps-get-page-dimensions)
  ;; final check
  (and ps-color-p
       (equal ps-default-background ps-default-foreground)
       (error
	(concat
	 "`ps-default-fg' and `ps-default-bg' have the same color.\n"
	 "Text won't appear on page.  Please, check these variables."))))


(defun ps-page-number ()
  (if ps-print-only-one-header
      (1+ (/ (1- ps-page-column) ps-number-of-columns))

  (ps-end-page)
  (ps-flush-output)
  (ps-begin-page))


(defun ps-end-sheet ()
  (and ps-print-page-p (> ps-page-sheet 0)
       (ps-output "EndSheet\n")))


(defun ps-header-sheet ()
  ;; Print only when a new sheet begins.
  (ps-end-sheet)
  (setq ps-page-sheet (1+ ps-page-sheet))
  (when (ps-print-sheet-p)
    (setq ps-page-order (1+ ps-page-order))
    (ps-output (if ps-n-up-on
		   (format "\n%%%%Page: (%d \\(%d\\)) %d\n"

  (ps-output (format "/LineNumber %d def\n" ps-showline-count)
	     (format "/PageNumber %d def\n" (ps-page-number)))

  (when ps-print-header
    (ps-generate-header "HeaderLinesLeft"  "/h0" "/h1"
			(or ps-lh-cache ps-left-header))
    (ps-generate-header "HeaderLinesRight" "/h0" "/h1"
			(or ps-rh-cache ps-right-header))
    (ps-output (format "%d SetHeaderLines\n" ps-header-lines))
    (setq ps-lh-cache nil
	  ps-rh-cache nil))

  (when ps-print-footer
    (ps-generate-header "FooterLinesLeft"  "/H0" "/H0"
			(or ps-lf-cache ps-left-footer))
    (ps-generate-header "FooterLinesRight" "/H0" "/H0"
			(or ps-rf-cache ps-right-footer))
    (ps-output (format "%d SetFooterLines\n" ps-footer-lines))
    (setq ps-lf-cache nil
	  ps-rf-cache nil))

  (ps-output (number-to-string ps-lines-printed) " BeginPage\n")
  (ps-set-font  ps-current-font)
  (ps-set-bg    ps-current-bg)
  (ps-set-color ps-current-color)

  (ps-plot 'ps-basic-plot-str 0 (length string) string))


(defvar ps-current-effect 0)

(defvar ps-print-translation-table
  (let ((tbl (make-char-table 'translation-table nil)))
    (if (and (boundp 'ucs-mule-8859-to-mule-unicode)
	   (char-table-p ucs-mule-8859-to-mule-unicode))
	(map-char-table
	 #'(lambda (k v)
	     (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v))
		 (aset tbl k v)))
	 ucs-mule-8859-to-mule-unicode))
    tbl)
  "Translation table for PostScript printing.
The default value is a table that translates non-Latin-1 Latin characters
to the equivalent Latin-1 characters.")

(defun ps-plot-region (from to font &optional fg-color bg-color effects)
  (or (equal font ps-current-font)
      (ps-set-font font))

	     (composition		; a composite sequence
	      (ps-plot 'ps-mule-plot-composition match-point (point) bg-color))

	     ((> match 255)		; a multi-byte character
	      (setq match (or (aref ps-print-translation-table match) match))
	      (let* ((charset (char-charset match))
		     (composition (ps-e-find-composition match-point to))
		     (stop (if (nth 2 composition) (car composition) to)))
		(or (eq charset 'composition)
		    (while (and (< (point) stop)
				(let ((ch (following-char)))
				  (setq ch
					(or (aref ps-print-translation-table ch)
					    ch))
				  (eq (char-charset ch) charset)))
		      (forward-char 1)))
		(ps-plot 'ps-mule-plot-string match-point (point) bg-color)))
					; characters from ^@ to ^_ and
	     (t				; characters from 127 to 255
	      (ps-control-character match)))

		(ps-face-foreground-name face)
		(ps-face-background-name face))))


;; to avoid compilation gripes
(defalias 'ps-jitify 'jit-lock-fontify-now)
(defalias 'ps-lazify 'lazy-lock-fontify-region)


;; to avoid compilation gripes
(defun ps-print-ensure-fontified (start end)
  (cond ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
	 (ps-jitify start end))
	((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
	 (ps-lazify start end))))


(defun ps-generate-postscript-with-faces (from to)
  ;; Some initialization...
  (setq ps-current-effect 0)

    (narrow-to-region from to)
    (ps-print-ensure-fontified from to)
    (let ((face 'default)
	  (position to))
      (cond
       ((featurep 'xemacs)		; xemacs
	;; Build the list of extents...
	(let ((a (cons 'dummy nil))
	      record type extent extent-list)
	  (ps-x-map-extents 'ps-mapper nil from to a)
	  (setq a (sort (cdr a) 'car-less-than-car)

			   (ps-x-extent-face (car extent-list))
			 'default)
		  from position
		  a (cdr a)))))

       (t				; emacs
	(let ((property-change from)
	      (overlay-change from)
	      (save-buffer-invisibility-spec buffer-invisibility-spec)
	      (buffer-invisibility-spec nil)
	      before-string after-string)

	(and ps-razzle-dazzle (message "Formatting...done"))))))


(defun ps-end-job (needs-begin-file)
  (let ((ps-print-page-p t))
    (ps-flush-output)
    (save-excursion
      (let ((pages-per-sheet (mod ps-page-printed ps-n-up-printing))
	    (total-lines (cdr ps-printing-region))
	    (total-pages (ps-page-number)))

	   (ps-output "/PrintHeader false def\n/ColumnIndex 0 def\n"
		      "/PrintLineNumber false def\n"
		      (number-to-string ps-lines-printed) " BeginPage\n")
	   (ps-end-page)))
    ;; Set end of PostScript file
    (ps-end-sheet)
    (ps-output "\n%%Trailer\n%%Pages: "
	       (number-to-string
		(if (and needs-begin-file
			 ps-banner-page-when-duplexing)
		    (1+ ps-page-order)

	(t (list list))))

(defun ps-kill-emacs-check ()
  (let (ps-buffer)
    (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
	 (buffer-name ps-buffer)	; check if it's not killed
	 (buffer-modified-p ps-buffer)
	 (y-or-n-p "Unprinted PostScript waiting; print now? ")
	 (ps-despool))
    (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
	 (buffer-name ps-buffer)	; check if it's not killed
	 (buffer-modified-p ps-buffer)
	 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
	 (error "Unprinted PostScript"))))

(cond ((fboundp 'add-hook)

;; WARNING!!! The following code is *sample* code only.
;; Don't use it unless you understand what it does!

(defmacro ps-prsc ()
  `(if (featurep 'xemacs) 'f22           [f22]))
(defmacro ps-c-prsc ()
  `(if (featurep 'xemacs) '(control f22) [C-f22]))
(defmacro ps-s-prsc ()
  `(if (featurep 'xemacs) '(shift f22)   [S-f22]))

;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the
;; `ps-left-headers' specially for mail messages.
(defun ps-rmail-mode-hook ()
  (local-set-key (ps-prsc) 'ps-rmail-print-message-from-summary)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(provide 'ps-print)

;;; arch-tag: fb06a585-1112-4206-885d-a57d95d50579
;;; ps-print.el ends here