]> code.delx.au - gnu-emacs/blobdiff - lisp/ps-print.el
ps-lpr-switches docstring fix.
[gnu-emacs] / lisp / ps-print.el
index f3f9e45fb872d9a07ef6251d931242c2f309e087..6be1f12d43908591366297758f4a9f0f28c91dac 100644 (file)
 ;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
 ;;     Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;; Keywords: wp, print, PostScript
 ;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
 ;;     Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;; Keywords: wp, print, PostScript
-;; Version: 6.7.5
+;; Version: 7.3.1
 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
 
 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
 
-(defconst ps-print-version "6.7.5"
-  "ps-print.el, v 6.7.5 <2007/07/20 vinicius>
+(defconst ps-print-version "7.3.1"
+  "ps-print.el, v 7.3.1 <2007/11/21 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
 
 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
@@ -1089,6 +1089,14 @@ Please send all bug fixes and enhancements to
 ;; You can also set `ps-print-color-p' to 'black-white to have a better looking
 ;; on black/white printers.  See also `ps-black-white-faces' for documentation.
 ;;
 ;; You can also set `ps-print-color-p' to 'black-white to have a better looking
 ;; on black/white printers.  See also `ps-black-white-faces' for documentation.
 ;;
+;; ps-print also detects if the text foreground and background colors are
+;; equals when `ps-fg-validate-p' is non-nil.  In this case, if these colors
+;; are used, no text will appear.  You can use `ps-fg-list' to give a list of
+;; foreground colors to be used when text foreground and background colors are
+;; equals.  It'll be used the first foreground color in `ps-fg-list' which is
+;; different from the background color.  If `ps-fg-list' is nil, the default
+;; foreground color is used. 
+;;
 ;;
 ;; How Ps-Print Maps Faces
 ;; -----------------------
 ;;
 ;; How Ps-Print Maps Faces
 ;; -----------------------
@@ -1212,85 +1220,88 @@ Please send all bug fixes and enhancements to
 ;;
 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;;
 ;;
 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;;
-;;    20040229
+;;    2007-10-27
+;;      `ps-fg-validate-p', `ps-fg-list'
+;;
+;;    2004-02-29
 ;;      `ps-time-stamp-yyyy-mm-dd', `ps-time-stamp-iso8601'
 ;;
 ;;      `ps-time-stamp-yyyy-mm-dd', `ps-time-stamp-iso8601'
 ;;
-;;    20010619
+;;    2001-06-19
 ;;      `ps-time-stamp-locale-default'
 ;;
 ;;      `ps-time-stamp-locale-default'
 ;;
-;;    20010530
+;;    2001-05-30
 ;;      Handle before-string and after-string overlay properties.
 ;;
 ;;      Handle before-string and after-string overlay properties.
 ;;
-;;    20010407
+;;    2001-04-07
 ;;      `ps-line-number-color', `ps-print-footer', `ps-footer-offset',
 ;;      `ps-print-footer-frame', `ps-footer-font-family',
 ;;      `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines',
 ;;      `ps-left-footer', `ps-right-footer', `ps-footer-frame-alist' and
 ;;      `ps-header-frame-alist'.
 ;;
 ;;      `ps-line-number-color', `ps-print-footer', `ps-footer-offset',
 ;;      `ps-print-footer-frame', `ps-footer-font-family',
 ;;      `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines',
 ;;      `ps-left-footer', `ps-right-footer', `ps-footer-frame-alist' and
 ;;      `ps-header-frame-alist'.
 ;;
-;;    20010328
+;;    2001-03-28
 ;;      `ps-line-spacing', `ps-paragraph-spacing', `ps-paragraph-regexp',
 ;;      `ps-begin-cut-regexp' and `ps-end-cut-regexp'.
 ;;
 ;;      `ps-line-spacing', `ps-paragraph-spacing', `ps-paragraph-regexp',
 ;;      `ps-begin-cut-regexp' and `ps-end-cut-regexp'.
 ;;
-;;    20001122
+;;    2000-11-22
 ;;      `ps-line-number-font', `ps-line-number-font-size' and
 ;;      `ps-end-with-control-d'.
 ;;
 ;;      `ps-line-number-font', `ps-line-number-font-size' and
 ;;      `ps-end-with-control-d'.
 ;;
-;;    20000821
+;;    2000-08-21
 ;;      `ps-even-or-odd-pages'
 ;;
 ;;      `ps-even-or-odd-pages'
 ;;
-;;    20000617
+;;    2000-06-17
 ;;      `ps-manual-feed', `ps-warn-paper-type', `ps-print-upside-down',
 ;;      `ps-selected-pages', `ps-last-selected-pages',
 ;;      `ps-restore-selected-pages', `ps-switch-header',
 ;;      `ps-line-number-step', `ps-line-number-start',
 ;;      `ps-zebra-stripe-follow' and `ps-use-face-background'.
 ;;
 ;;      `ps-manual-feed', `ps-warn-paper-type', `ps-print-upside-down',
 ;;      `ps-selected-pages', `ps-last-selected-pages',
 ;;      `ps-restore-selected-pages', `ps-switch-header',
 ;;      `ps-line-number-step', `ps-line-number-start',
 ;;      `ps-zebra-stripe-follow' and `ps-use-face-background'.
 ;;
-;;    20000310
+;;    2000-03-10
 ;;      PostScript error handler.
 ;;      `ps-user-defined-prologue' and `ps-error-handler-message'.
 ;;
 ;;      PostScript error handler.
 ;;      `ps-user-defined-prologue' and `ps-error-handler-message'.
 ;;
-;;    19991211
+;;    1999-12-11
 ;;      `ps-print-customize'.
 ;;
 ;;      `ps-print-customize'.
 ;;
-;;    19990703
+;;    1999-07-03
 ;;      Better customization.
 ;;      `ps-banner-page-when-duplexing' and `ps-zebra-color'.
 ;;
 ;;      Better customization.
 ;;      `ps-banner-page-when-duplexing' and `ps-zebra-color'.
 ;;
-;;    19990513
+;;    1999-05-13
 ;;      N-up printing.
 ;;      Hook: `ps-print-begin-sheet-hook'.
 ;;
 ;;      N-up printing.
 ;;      Hook: `ps-print-begin-sheet-hook'.
 ;;
-;; [kenichi] 19990509 Ken'ichi Handa <handa@m17n.org>
+;; [kenichi] 1999-05-09 Ken'ichi Handa <handa@m17n.org>
 ;;
 ;;    `ps-print-region-function'
 ;;
 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;;
 ;;
 ;;    `ps-print-region-function'
 ;;
 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;;
-;;    19990301
+;;    1999-03-01
 ;;      PostScript tumble and setpagedevice.
 ;;
 ;;      PostScript tumble and setpagedevice.
 ;;
-;;    19980922
+;;    1998-09-22
 ;;      PostScript prologue header comment insertion.
 ;;      Skip invisible text better.
 ;;
 ;;      PostScript prologue header comment insertion.
 ;;      Skip invisible text better.
 ;;
-;; [kenichi] 19980819 Ken'ichi Handa <handa@m17n.org>
+;; [kenichi] 1998-08-19 Ken'ichi Handa <handa@m17n.org>
 ;;
 ;;    Multi-byte buffer handling.
 ;;
 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;;
 ;;
 ;;    Multi-byte buffer handling.
 ;;
 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;;
-;;    19980306
+;;    1998-03-06
 ;;      Skip invisible text.
 ;;
 ;;      Skip invisible text.
 ;;
-;;    19971130
+;;    1997-11-30
 ;;      Hooks: `ps-print-hook', `ps-print-begin-page-hook' and
 ;;      `ps-print-begin-column-hook'.
 ;;      Put one header per page over the columns.
 ;;      Better database font management.
 ;;      Better control characters handling.
 ;;
 ;;      Hooks: `ps-print-hook', `ps-print-begin-page-hook' and
 ;;      `ps-print-begin-column-hook'.
 ;;      Put one header per page over the columns.
 ;;      Better database font management.
 ;;      Better control characters handling.
 ;;
-;;    19971121
+;;    1997-11-21
 ;;      Dynamic evaluation at print time of `ps-lpr-switches'.
 ;;      Handle control characters.
 ;;      Face remapping.
 ;;      Dynamic evaluation at print time of `ps-lpr-switches'.
 ;;      Handle control characters.
 ;;      Face remapping.
@@ -1299,12 +1310,12 @@ Please send all bug fixes and enhancements to
 ;;      Zebra stripes.
 ;;      Text and/or image on background.
 ;;
 ;;      Zebra stripes.
 ;;      Text and/or image on background.
 ;;
-;; [jack] 19960517 Jacques Duthen <duthen@cegelec-red.fr>
+;; [jack] 1996-05-17 Jacques Duthen <duthen@cegelec-red.fr>
 ;;
 ;;
-;; Font family and float size for text and header.
-;; Landscape mode.
-;; Multiple columns.
-;; Tools for page setup.
+;;    Font family and float size for text and header.
+;;    Landscape mode.
+;;    Multiple columns.
+;;    Tools for page setup.
 ;;
 ;;
 ;; Known bugs and limitations of ps-print
 ;;
 ;;
 ;; Known bugs and limitations of ps-print
@@ -1331,7 +1342,7 @@ Please send all bug fixes and enhancements to
 ;;
 ;; Faces are always treated as opaque.
 ;;
 ;;
 ;; Faces are always treated as opaque.
 ;;
-;; Epoch, Lucid and Emacs 21 not supported.  At all.
+;; Epoch, Lucid and Emacs 22 not supported.  At all.
 ;;
 ;; Fixed-pitch fonts work better for line folding, but are not required.
 ;;
 ;;
 ;; Fixed-pitch fonts work better for line folding, but are not required.
 ;;
@@ -1343,8 +1354,11 @@ Please send all bug fixes and enhancements to
 ;; ----------------
 ;;
 ;; Avoid page break inside a paragraph.
 ;; ----------------
 ;;
 ;; Avoid page break inside a paragraph.
+;;
 ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
 ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
+;;
 ;; Improve the memory management for big files (hard?).
 ;; Improve the memory management for big files (hard?).
+;;
 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care of folding
 ;; lines.
 ;;
 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care of folding
 ;; lines.
 ;;
@@ -1445,61 +1459,16 @@ Please send all bug fixes and enhancements to
 
 (require 'lpr)
 
 
 (require 'lpr)
 
+
 (or (featurep 'lisp-float-type)
     (error "`ps-print' requires floating point support"))
 
 (or (featurep 'lisp-float-type)
     (error "`ps-print' requires floating point support"))
 
-(let ((case-fold-search t))
-  (cond ((string-match "XEmacs" emacs-version))
-       ((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 22))
-          (error "`ps-print' only supports Emacs 22 and higher")))))
 
 
-
-;; 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)
-(defalias 'ps-e-find-composition (if (fboundp 'find-composition)
-                                    'find-composition
-                                  'ignore))
+(if (featurep 'xemacs)
+    ()
+  (unless (and (boundp 'emacs-major-version)
+              (>= emacs-major-version 23))
+    (error "`ps-print' only supports Emacs 23 and higher")))
 
 
 (defconst ps-windows-system
 
 
 (defconst ps-windows-system
@@ -1508,32 +1477,8 @@ Please send all bug fixes and enhancements to
   (memq system-type '(usg-unix-v dgux hpux irix)))
 
 
   (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))
-
-(defalias 'ps-frame-parameter
-  (if (fboundp 'frame-parameter) 'frame-parameter 'frame-property))
-
-(defalias 'ps-mark-active-p
-  (if (fboundp 'region-active-p)
-      'region-active-p                 ; XEmacs
-    (defvar mark-active)               ; To shup up XEmacs's byte compiler.
-    (lambda () mark-active)))          ; Emacs
-
-(cond ((featurep 'xemacs)              ; XEmacs
-       (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 22 or higher
-       (defun ps-face-foreground-name (face)
-        (face-foreground face nil t))
-       (defun ps-face-background-name (face)
-        (face-background face nil t))
-       ))
+;; Load XEmacs/Emacs definitions
+(eval-and-compile (require 'ps-def))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1807,7 +1752,28 @@ an explicit filename is given as the last argument."
   :group 'ps-print-printer)
 
 (defcustom ps-lpr-switches lpr-switches
   :group 'ps-print-printer)
 
 (defcustom ps-lpr-switches lpr-switches
-  "*A list of extra switches to pass to `ps-lpr-command'."
+  "*List of extra switches to pass to `ps-lpr-command'.
+
+The list element can be:
+
+   string      it should be an option for `ps-lpr-command' (which see).
+               For example: \"-o Duplex=DuplexNoTumble\"
+
+   symbol      it can be a function or variable symbol.  If it's a function
+               symbol, it should be a function with no argument.  The result
+               of the function or the variable value should be a string or a
+               list of strings.
+
+   list                the header should be a symbol function and the tail is the
+               arguments for this function.  This function should return a
+               string or a list of strings.
+
+Any other value is silently ignored.
+
+It is recommended to set `ps-printer-name' (which see) instead of including an
+explicit switch on this list.
+
+See `ps-lpr-command'."
   :type '(repeat :tag "PostScript lpr Switches"
                 (choice :menu-tag "PostScript lpr Switch"
                         :tag "PostScript lpr Switch"
   :type '(repeat :tag "PostScript lpr Switches"
                 (choice :menu-tag "PostScript lpr Switch"
                         :tag "PostScript lpr Switch"
@@ -3014,7 +2980,7 @@ Valid values are:
    LIST                It's a list of RGB values, that is a list of three real values
                of the form:
 
    LIST                It's a list of RGB values, that is a list of three real values
                of the form:
 
-                 (RED, GREEN, BLUE)
+                 (RED GREEN BLUE)
 
                Where RED, GREEN and BLUE are reals between 0.0 (no color) and
                1.0 (full color).
 
                Where RED, GREEN and BLUE are reals between 0.0 (no color) and
                1.0 (full color).
@@ -3058,7 +3024,7 @@ Valid values are:
    LIST                It's a list of RGB values, that is a list of three real values
                of the form:
 
    LIST                It's a list of RGB values, that is a list of three real values
                of the form:
 
-                 (RED, GREEN, BLUE)
+                 (RED GREEN BLUE)
 
                Where RED, GREEN and BLUE are reals between 0.0 (no color) and
                1.0 (full color).
 
                Where RED, GREEN and BLUE are reals between 0.0 (no color) and
                1.0 (full color).
@@ -3082,6 +3048,58 @@ See also `ps-use-face-background'."
   :version "20"
   :group 'ps-print-color)
 
   :version "20"
   :group 'ps-print-color)
 
+(defcustom ps-fg-list nil
+  "*Specify foreground color list.
+
+This list is used to chose a text foreground color which is different than the
+background color.  It'll be used the first foreground color in `ps-fg-list'
+which is different from the background color.
+
+If this list is nil, the default foreground color is used.  See
+`ps-default-fg'.
+
+The list element valid values are:
+
+   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 color will be used.
+
+This variable is used only when `ps-fg-validate-p' (which see) is non-nil and
+when `ps-print-color-p' (which see) is neither nil nor black-white."
+  :type '(repeat
+         (choice :menu-tag "Foreground Gray/Color"
+                 :tag "Foreground Gray/Color"
+                 (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 "22"
+  :group 'ps-print-color)
+
+(defcustom ps-fg-validate-p t
+  "*Non-nil means validate if foreground color is different than background.
+
+If text foreground and background colors are equals, no text will appear.
+
+See also `ps-fg-list'."
+  :type 'boolean
+  :version "22"
+  :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
 (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
@@ -3346,9 +3364,9 @@ It's like the very first character of buffer (or region) is ^L (\\014)."
 (defcustom ps-postscript-code-directory
   (or (if (featurep 'xemacs)
          (cond ((fboundp 'locate-data-directory) ; XEmacs
 (defcustom ps-postscript-code-directory
   (or (if (featurep 'xemacs)
          (cond ((fboundp 'locate-data-directory) ; XEmacs
-                (locate-data-directory "ps-print"))
+                (funcall 'locate-data-directory "ps-print"))
                ((boundp 'data-directory) ; XEmacs
                ((boundp 'data-directory) ; XEmacs
-                data-directory)
+                (symbol-value 'data-directory))
                (t                      ; don't know what to do
                 nil))
        data-directory)                 ; Emacs
                (t                      ; don't know what to do
                 nil))
        data-directory)                 ; Emacs
@@ -3627,9 +3645,11 @@ The table depends on the current ps-print setup."
       '(23 . ps-line-number-step)
       '(23 . ps-line-number-start)
       nil
       '(23 . ps-line-number-step)
       '(23 . ps-line-number-start)
       nil
-      '(17 . ps-default-fg)
-      '(17 . ps-default-bg)
       '(17 . ps-razzle-dazzle)
       '(17 . ps-razzle-dazzle)
+      '(17 . ps-default-bg)
+      '(17 . ps-default-fg)
+      '(17 . ps-fg-validate-p)
+      '(17 . ps-fg-list)
       nil
       '(23 . ps-use-face-background)
       nil
       nil
       '(23 . ps-use-face-background)
       nil
@@ -3709,9 +3729,9 @@ The table depends on the current ps-print setup."
       '(20 . ps-underlined-faces)
       '(20 . ps-black-white-faces)
       "      )\n
       '(20 . ps-underlined-faces)
       '(20 . ps-black-white-faces)
       "      )\n
-;; The following customized variables have long lists and are seldom modified:
-;;    ps-page-dimensions-database
-;;    ps-font-info-database
+\;; The following customized variables have long lists and are seldom modified:
+\;;    ps-page-dimensions-database
+\;;    ps-font-info-database
 
 \;;; ps-print - end of settings\n")
      "\n")))
 
 \;;; ps-print - end of settings\n")
      "\n")))
@@ -3844,108 +3864,6 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'."
   (format-time-string "%T"))
 
 
   (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.
-(defalias 'ps-color-device
-  (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
-        (lambda ()
-          (eq (ps-x-device-class) 'color)))
-
-       (t                              ; Emacs
-        (lambda ()
-          (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)
-       (defvar coding-system-for-read)
-       (defvar buffer-file-coding-system)
-
-       (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-print-color-scale 1.0)
 
 (defun ps-color-scale (color)
@@ -4020,20 +3938,12 @@ Note: No major/minor-mode is activated and no local variables are evaluated for
 (defvar ps-default-color nil)
 (defvar ps-current-color nil)
 (defvar ps-current-bg nil)
 (defvar ps-default-color nil)
 (defvar ps-current-color nil)
 (defvar ps-current-bg nil)
+(defvar ps-foreground-list nil)
 
 (defvar ps-zebra-stripe-full-p nil)
 (defvar ps-razchunk 0)
 
 (defvar ps-color-p 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
 
 ;; 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
@@ -4819,65 +4729,35 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
     (goto-char (point-max))
     (insert-file-contents fname)))
 
     (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.
 
 ;; These functions insert the arrays that define the contents of the headers.
 
+(defvar ps-encode-header-string-function nil)
+
 (defun ps-generate-header-line (fonttag &optional content)
   (ps-output " [" fonttag " ")
   (cond
    ;; Literal strings should be output as is -- the string must contain its own
    ;; PS string delimiters, '(' and ')', if necessary.
    ((stringp content)
 (defun ps-generate-header-line (fonttag &optional content)
   (ps-output " [" fonttag " ")
   (cond
    ;; Literal strings should be output as is -- the string must contain its own
    ;; PS string delimiters, '(' and ')', if necessary.
    ((stringp content)
-    (ps-output (ps-mule-encode-header-string content fonttag)))
+    (ps-output content))
 
    ;; Functions are called -- they should return strings; they will be inserted
    ;; as strings and the PS string delimiters added.
    ((functionp content)
 
    ;; 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)))
+    (if (functionp ps-encode-header-string-function)
+       (dolist (l (funcall ps-encode-header-string-function
+                           (funcall content) fonttag))
+         (ps-output-string l))
+      (ps-output-string (funcall content))))
 
    ;; Variables will have their contents inserted.  They should contain
    ;; strings, and will be inserted as strings.
    ((and (symbolp content) (boundp content))
 
    ;; Variables will have their contents inserted.  They should contain
    ;; strings, and will be inserted as strings.
    ((and (symbolp content) (boundp content))
-    (ps-output-string (ps-mule-encode-header-string (symbol-value content)
-                                                   fonttag)))
+    (if (fboundp ps-encode-header-string-function)
+       (dolist (l (funcall ps-encode-header-string-function
+                            (symbol-value content) fonttag))
+         (ps-output-string l))
+      (ps-output-string (symbol-value content))))
 
    ;; Anything else will get turned into an empty string.
    (t
 
    ;; Anything else will get turned into an empty string.
    (t
@@ -4943,15 +4823,6 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
        (vector 0 0 0 0)))))
 
 
        (vector 0 0 0 0)))))
 
 
-;; 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)
 (defun ps-float-format (value &optional default)
   (let ((literal (or value default)))
     (cond ((null literal)
@@ -5028,15 +4899,15 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
 
 (defun ps-background (page-number)
   (let (has-local-background)
 
 (defun ps-background (page-number)
   (let (has-local-background)
-    (mapcar #'(lambda (range)
-               (and (<= (aref range 0) page-number)
-                    (<= page-number (aref range 1))
-                    (if has-local-background
-                        (ps-output (aref range 2))
-                      (setq has-local-background t)
-                      (ps-output "/printLocalBackground{\n"
-                                 (aref range 2)))))
-           ps-background-pages)
+    (mapc #'(lambda (range)
+             (and (<= (aref range 0) page-number)
+                  (<= page-number (aref range 1))
+                  (if has-local-background
+                      (ps-output (aref range 2))
+                    (setq has-local-background t)
+                    (ps-output "/printLocalBackground{\n"
+                               (aref range 2)))))
+         ps-background-pages)
     (and has-local-background (ps-output "}def\n"))))
 
 
     (and has-local-background (ps-output "}def\n"))))
 
 
@@ -5672,7 +5543,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
 
     (ps-output "\n" ps-print-prologue-1
               "\n/printGlobalBackground{\n")
 
     (ps-output "\n" ps-print-prologue-1
               "\n/printGlobalBackground{\n")
-    (mapcar 'ps-output ps-background-all-pages)
+    (mapc 'ps-output ps-background-all-pages)
     (ps-output
      "}def\n/printLocalBackground{\n}def\n"
      "\n%%EndProlog\n\n%%BeginSetup\n"
     (ps-output
      "}def\n/printLocalBackground{\n}def\n"
      "\n%%EndProlog\n\n%%BeginSetup\n"
@@ -5852,6 +5723,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
    (t
     (list default default default))))
 
    (t
     (list default default default))))
 
+(defvar ps-basic-plot-string-function 'ps-basic-plot-string)
 
 (defun ps-begin-job (genfunc)
   ;; prologue files
 
 (defun ps-begin-job (genfunc)
   ;; prologue files
@@ -5957,13 +5829,27 @@ XSTART YSTART are the relative position for the first page in a sheet.")
                                 ps-default-fg))
                               "unspecified-fg"
                               0.0)
                                 ps-default-fg))
                               "unspecified-fg"
                               0.0)
+       ps-foreground-list    (mapcar
+                              #'(lambda (arg)
+                                  (ps-rgb-color arg "unspecified-fg" 0.0))
+                              (append (and (not (member ps-print-color-p
+                                                        '(nil back-white)))
+                                           ps-fg-list)
+                                      (list ps-default-foreground
+                                            "black")))
        ps-default-color      (and (not (member ps-print-color-p
                                                '(nil back-white)))
                                   ps-default-foreground)
        ps-default-color      (and (not (member ps-print-color-p
                                                '(nil back-white)))
                                   ps-default-foreground)
-       ps-current-color      ps-default-color)
+       ps-current-color      ps-default-color
+       ;; Set up default functions.
+       ;; They may be overridden by ps-mule-begin-job.
+       ps-basic-plot-string-function    'ps-basic-plot-string
+       ps-encode-header-string-function nil)
   ;; initialize page dimensions
   (ps-get-page-dimensions)
   ;; final check
   ;; initialize page dimensions
   (ps-get-page-dimensions)
   ;; final check
+  (unless (listp ps-lpr-switches)
+    (error "`ps-lpr-switches' value should be a list."))
   (and ps-color-p
        (equal ps-default-background ps-default-foreground)
        (error
   (and ps-color-p
        (equal ps-default-background ps-default-foreground)
        (error
@@ -6045,28 +5931,19 @@ XSTART YSTART are the relative position for the first page in a sheet.")
             (format "/PageNumber %d def\n" (ps-page-number)))
 
   (when ps-print-header
             (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))
+    (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
 
   (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-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-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-mule-begin-page))
+  (ps-set-color ps-current-color))
 
 (defsubst ps-skip-newline (limit)
   (setq ps-showline-count (1+ ps-showline-count)
 
 (defsubst ps-skip-newline (limit)
   (setq ps-showline-count (1+ ps-showline-count)
@@ -6110,7 +5987,6 @@ XSTART YSTART are the relative position for the first page in a sheet.")
                                       (ps-avg-char-width 'ps-font-for-text)))
         (to (car wrappoint))
         (str (substring string from to)))
                                       (ps-avg-char-width 'ps-font-for-text)))
         (to (car wrappoint))
         (str (substring string from to)))
-    (ps-mule-prepare-ascii-font str)
     (ps-output-string str)
     (ps-output " S\n")
     wrappoint))
     (ps-output-string str)
     (ps-output " S\n")
     wrappoint))
@@ -6120,7 +5996,6 @@ XSTART YSTART are the relative position for the first page in a sheet.")
                                       (ps-avg-char-width 'ps-font-for-text)))
         (to (car wrappoint))
         (string (buffer-substring-no-properties from to)))
                                       (ps-avg-char-width 'ps-font-for-text)))
         (to (car wrappoint))
         (string (buffer-substring-no-properties from to)))
-    (ps-mule-prepare-ascii-font string)
     (ps-output-string string)
     (ps-output " S\n")
     wrappoint))
     (ps-output-string string)
     (ps-output " S\n")
     wrappoint))
@@ -6200,16 +6075,24 @@ to the equivalent Latin-1 characters.")
   (or (equal font ps-current-font)
       (ps-set-font font))
 
   (or (equal font ps-current-font)
       (ps-set-font font))
 
-  ;; Specify a foreground color only if one's specified and it's
-  ;; different than the current.
+  ;; Specify a foreground color only if:
+  ;;    one's specified,
+  ;;    it's different than the background (if `ps-fg-validate-p' is non-nil)
+  ;;    and it's different than the current.
   (let ((fg (or fg-color ps-default-foreground)))
   (let ((fg (or fg-color ps-default-foreground)))
+    (if ps-fg-validate-p
+       (let ((bg (or bg-color ps-default-background))
+             (el ps-foreground-list))
+         (while (and el (equal fg bg))
+           (setq fg (car el)
+                 el (cdr el)))))
     (or (equal fg ps-current-color)
        (ps-set-color fg)))
 
   (or (equal bg-color ps-current-bg)
       (ps-set-bg bg-color))
 
     (or (equal fg ps-current-color)
        (ps-set-color fg)))
 
   (or (equal bg-color ps-current-bg)
       (ps-set-bg bg-color))
 
-  ;; Specify effects (underline, overline, box, etc)
+  ;; Specify effects (underline, overline, box, etc.)
   (cond
    ((not (integerp effects))
     (ps-output "0 EF\n")
   (cond
    ((not (integerp effects))
     (ps-output "0 EF\n")
@@ -6237,26 +6120,16 @@ to the equivalent Latin-1 characters.")
       (if (re-search-forward ps-control-or-escape-regexp to t)
          ;; region with some control characters or some multi-byte characters
          (let* ((match-point (match-beginning 0))
       (if (re-search-forward ps-control-or-escape-regexp to t)
          ;; region with some control characters or some multi-byte characters
          (let* ((match-point (match-beginning 0))
-                (match       (char-after match-point))
-                (composition (ps-e-find-composition from (1+ match-point))))
-           (if composition
-               (if (and (nth 2 composition)
-                        (<= (car composition) match-point))
-                   (progn
-                     (setq match-point (car composition)
-                           match 0)
-                     (goto-char (nth 1 composition)))
-                 (setq composition nil)))
+                (match       (char-after match-point)))
            (when (< from match-point)
            (when (< from match-point)
-             (ps-mule-set-ascii-font)
-             (ps-plot 'ps-basic-plot-string from match-point bg-color))
+             (ps-plot ps-basic-plot-string-function
+                      from match-point bg-color))
            (cond
             ((= match ?\t)             ; tab
              (let ((linestart (line-beginning-position)))
                (forward-char -1)
                (setq from (+ linestart (current-column)))
                (when (re-search-forward "[ \t]+" to t)
            (cond
             ((= match ?\t)             ; tab
              (let ((linestart (line-beginning-position)))
                (forward-char -1)
                (setq from (+ linestart (current-column)))
                (when (re-search-forward "[ \t]+" to t)
-                 (ps-mule-set-ascii-font)
                  (ps-plot 'ps-basic-plot-whitespace
                           from (+ linestart (current-column))
                           bg-color))))
                  (ps-plot 'ps-basic-plot-whitespace
                           from (+ linestart (current-column))
                           bg-color))))
@@ -6281,30 +6154,11 @@ to the equivalent Latin-1 characters.")
                     (ps-skip-newline to))
                (ps-next-page)))
 
                     (ps-skip-newline to))
                (ps-next-page)))
 
-            (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)))
            (setq from (point)))
             (t                         ; characters from 127 to 255
              (ps-control-character match)))
            (setq from (point)))
-       ;; region without control characters nor multi-byte characters
-       (ps-mule-set-ascii-font)
-       (ps-plot 'ps-basic-plot-string from to bg-color)
+       ;; region without control characters
+       (ps-plot ps-basic-plot-string-function from to bg-color)
        (setq from to)))))
 
 (defvar ps-string-control-codes
        (setq from to)))))
 
 (defvar ps-string-control-codes
@@ -6336,11 +6190,22 @@ to the equivalent Latin-1 characters.")
     (if (< (car wrappoint) to)
        (ps-continue-line))
     (setq ps-width-remaining (- ps-width-remaining (* len char-width)))
     (if (< (car wrappoint) to)
        (ps-continue-line))
     (setq ps-width-remaining (- ps-width-remaining (* len char-width)))
-    (ps-mule-prepare-ascii-font str)
     (ps-output-string str)
     (ps-output " S\n")))
 
 
     (ps-output-string str)
     (ps-output " S\n")))
 
 
+(defsubst ps-face-foreground-color-p (attr)
+  (memq attr '(foreground-color :foreground)))
+
+
+(defsubst ps-face-background-color-p (attr)
+  (memq attr '(background-color :background)))
+
+
+(defsubst ps-face-color-p (attr)
+  (memq attr '(foreground-color :foreground background-color :background)))
+
+
 (defun ps-face-attributes (face)
   "Return face attribute vector.
 
 (defun ps-face-attributes (face)
   "Return face attribute vector.
 
@@ -6364,27 +6229,26 @@ If FACE is not a valid face name, use default face."
                   (setq ps-print-face-alist
                         (cons new-face ps-print-face-alist)))
               new-face))))
                   (setq ps-print-face-alist
                         (cons new-face ps-print-face-alist)))
               new-face))))
-   ((eq (car face) 'foreground-color)
+   ((ps-face-foreground-color-p (car face))
     (vector 0 (cdr face) nil))
     (vector 0 (cdr face) nil))
-   ((eq (car face) 'background-color)
+   ((ps-face-background-color-p (car face))
     (vector 0 nil (cdr face)))
    (t
     (vector 0 nil nil))))
 
 
 (defun ps-face-background (face background)
     (vector 0 nil (cdr face)))
    (t
     (vector 0 nil nil))))
 
 
 (defun ps-face-background (face background)
-  (and (cond ((eq ps-use-face-background t))   ; always
+  (and (cond ((eq ps-use-face-background t))    ; always
             ((null ps-use-face-background) nil) ; never
             ;; ps-user-face-background is a symbol face list
             ((symbolp face)
              (memq face ps-use-face-background))
             ((listp face)
             ((null ps-use-face-background) nil) ; never
             ;; ps-user-face-background is a symbol face list
             ((symbolp face)
              (memq face ps-use-face-background))
             ((listp face)
-             (or (memq (car face) '(foreground-color background-color))
+             (or (ps-face-color-p (car face))
                  (let (ok)
                    (while face
                      (if (or (memq (car face) ps-use-face-background)
                  (let (ok)
                    (while face
                      (if (or (memq (car face) ps-use-face-background)
-                             (memq (car face)
-                                   '(foreground-color background-color)))
+                             (ps-face-color-p (car face)))
                          (setq face nil
                                ok   t)
                        (setq face (cdr face))))
                          (setq face nil
                                ok   t)
                        (setq face (cdr face))))
@@ -6401,10 +6265,10 @@ If FACE is not a valid face name, use default face."
    ((not (listp face-or-list))
     (ps-face-attributes face-or-list))
    ;; only foreground color, not a `real' face
    ((not (listp face-or-list))
     (ps-face-attributes face-or-list))
    ;; only foreground color, not a `real' face
-   ((eq (car face-or-list) 'foreground-color)
+   ((ps-face-foreground-color-p (car face-or-list))
     (vector 0 (cdr face-or-list) nil))
    ;; only background color, not a `real' face
     (vector 0 (cdr face-or-list) nil))
    ;; only background color, not a `real' face
-   ((eq (car face-or-list) 'background-color)
+   ((ps-face-background-color-p (car face-or-list))
     (vector 0 nil (cdr face-or-list)))
    ;; list of faces
    (t
     (vector 0 nil (cdr face-or-list)))
    ;; list of faces
    (t
@@ -6459,10 +6323,10 @@ If FACE is not a valid face name, use default face."
   ;; Now, rebuild reference face lists
   (setq ps-print-face-alist nil)
   (if ps-auto-font-detect
   ;; Now, rebuild reference face lists
   (setq ps-print-face-alist nil)
   (if ps-auto-font-detect
-      (mapcar 'ps-map-face (face-list))
-    (mapcar 'ps-set-face-bold ps-bold-faces)
-    (mapcar 'ps-set-face-italic ps-italic-faces)
-    (mapcar 'ps-set-face-underline ps-underlined-faces))
+      (mapc 'ps-map-face (face-list))
+    (mapc 'ps-set-face-bold ps-bold-faces)
+    (mapc 'ps-set-face-italic ps-italic-faces)
+    (mapc 'ps-set-face-underline ps-underlined-faces))
   (setq ps-build-face-reference nil))
 
 
   (setq ps-build-face-reference nil))
 
 
@@ -6537,125 +6401,7 @@ If FACE is not a valid face name, use default face."
   (save-restriction
     (narrow-to-region from to)
     (ps-print-ensure-fontified from to)
   (save-restriction
     (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)
-               extent-list nil)
-
-         ;; Loop through the extents...
-         (while a
-           (setq record (car a)
-                 position (car record)
-
-                 record (cdr record)
-                 type (car record)
-
-                 record (cdr record)
-                 extent (car record))
-
-           ;; Plot up to this record.
-           ;; XEmacs 19.12: for some reason, we're getting into a
-           ;; situation in which some of the records have
-           ;; positions less than 'from'.  Since we've narrowed
-           ;; the buffer, this'll generate errors.  This is a hack,
-           ;; but don't call ps-plot-with-face unless from > point-min.
-           (and (>= from (point-min))
-                (ps-plot-with-face from (min position (point-max)) face))
-
-           (cond
-            ((eq type 'push)
-             (and (ps-x-extent-face extent)
-                  (setq extent-list (sort (cons extent extent-list)
-                                          'ps-extent-sorter))))
-
-            ((eq type 'pull)
-             (setq extent-list (sort (delq extent extent-list)
-                                     'ps-extent-sorter))))
-
-           (setq face (if extent-list
-                          (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)
-         (while (< from to)
-           (and (< property-change to) ; Don't search for property change
-                                       ; unless previous search succeeded.
-                (setq property-change (next-property-change from nil to)))
-           (and (< overlay-change to)  ; Don't search for overlay change
-                                       ; unless previous search succeeded.
-                (setq overlay-change (min (ps-e-next-overlay-change from)
-                                          to)))
-           (setq position (min property-change overlay-change)
-                 before-string nil
-                 after-string nil)
-           ;; The code below is not quite correct,
-           ;; because a non-nil overlay invisible property
-           ;; which is inactive according to the current value
-           ;; of buffer-invisibility-spec nonetheless overrides
-           ;; a face text property.
-           (setq face
-                 (cond ((let ((prop (get-text-property from 'invisible)))
-                          ;; Decide whether this invisible property
-                          ;; really makes the text invisible.
-                          (if (eq save-buffer-invisibility-spec t)
-                              (not (null prop))
-                            (or (memq prop save-buffer-invisibility-spec)
-                                (assq prop save-buffer-invisibility-spec))))
-                        'emacs--invisible--face)
-                       ((get-text-property from 'face))
-                       (t 'default)))
-           (let ((overlays (ps-e-overlays-at from))
-                 (face-priority -1))   ; text-property
-             (while (and overlays
-                         (not (eq face 'emacs--invisible--face)))
-               (let* ((overlay (car overlays))
-                      (overlay-invisible
-                       (ps-e-overlay-get overlay 'invisible))
-                      (overlay-priority
-                       (or (ps-e-overlay-get overlay 'priority) 0)))
-                 (and (> overlay-priority face-priority)
-                      (setq before-string
-                            (or (ps-e-overlay-get overlay 'before-string)
-                                before-string)
-                            after-string
-                            (or (and (<= (ps-e-overlay-end overlay) position)
-                                     (ps-e-overlay-get overlay 'after-string))
-                                after-string)
-                            face-priority overlay-priority
-                            face
-                            (cond
-                             ((if (eq save-buffer-invisibility-spec t)
-                                  (not (null overlay-invisible))
-                                (or (memq overlay-invisible
-                                          save-buffer-invisibility-spec)
-                                    (assq overlay-invisible
-                                          save-buffer-invisibility-spec)))
-                              'emacs--invisible--face)
-                             ((ps-e-overlay-get overlay 'face))
-                             (t face)
-                             ))))
-               (setq overlays (cdr overlays))))
-           ;; Plot up to this record.
-           (and before-string
-                (ps-plot-string before-string))
-           (ps-plot-with-face from position face)
-           (and after-string
-                (ps-plot-string after-string))
-           (setq from position)))))
-      (ps-plot-with-face from to face))))
+    (ps-generate-postscript-with-faces1 from to)))
 
 (defun ps-generate-postscript (from to)
   (ps-plot-region from to 0))
 
 (defun ps-generate-postscript (from to)
   (ps-plot-region from to 0))
@@ -6703,6 +6449,7 @@ If FACE is not a valid face name, use default face."
                (ps-begin-page)
                (funcall genfunc from to)
                (ps-end-page)
                (ps-begin-page)
                (funcall genfunc from to)
                (ps-end-page)
+               (ps-mule-end-job)
                (ps-end-job needs-begin-file)
 
                ;; Setting this variable tells the unwind form that the
                (ps-end-job needs-begin-file)
 
                ;; Setting this variable tells the unwind form that the
@@ -6800,10 +6547,23 @@ If FACE is not a valid face name, use default face."
                 (and (fboundp 'start-process) 0)
                 nil
                 (ps-flatten-list       ; dynamic evaluation
                 (and (fboundp 'start-process) 0)
                 nil
                 (ps-flatten-list       ; dynamic evaluation
-                 (mapcar 'ps-eval-switch ps-lpr-switches)))))
+                 (ps-string-list
+                  (mapcar 'ps-eval-switch ps-lpr-switches))))))
       (and ps-razzle-dazzle (message "Printing...done")))
     (kill-buffer ps-spool-buffer)))
 
       (and ps-razzle-dazzle (message "Printing...done")))
     (kill-buffer ps-spool-buffer)))
 
+(defun ps-string-list (arg)
+  (let (lstr)
+    (dolist (elm arg)
+      (cond ((stringp elm)
+            (setq lstr (cons elm lstr)))
+           ((listp elm)
+            (let ((s (ps-string-list elm)))
+              (when s
+                (setq lstr (cons s lstr)))))
+           (t )))                      ; ignore any other value
+    (nreverse lstr)))
+
 ;; Dynamic evaluation
 (defun ps-eval-switch (arg)
   (cond ((stringp arg) arg)
 ;; Dynamic evaluation
 (defun ps-eval-switch (arg)
   (cond ((stringp arg) arg)
@@ -6848,213 +6608,13 @@ If FACE is not a valid face name, use default face."
       (t
        (setq kill-emacs-hook 'ps-kill-emacs-check)))
 
       (t
        (setq kill-emacs-hook 'ps-kill-emacs-check)))
 
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Sample Setup Code:
-
-
-;; This stuff is for anybody that's brave enough to look this far,
-;; and able to figure out how to use it.  It isn't really part of
-;; ps-print, but I'll leave it here in hopes it might be useful:
-
-;; WARNING!!! The following code is *sample* code only.
-;; Don't use it unless you understand what it does!
-
-;; The key `f22' should probably be replaced by `print'.  --Stef
-
-;; 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 [(f22)] 'ps-rmail-print-message-from-summary)
-  (setq ps-header-lines 3
-       ps-left-header
-       ;; The left headers will display the message's subject, its
-       ;; author, and the name of the folder it was in.
-       '(ps-article-subject ps-article-author buffer-name)))
-
-;; See `ps-gnus-print-article-from-summary'.  This function does the
-;; same thing for rmail.
-(defun ps-rmail-print-message-from-summary ()
-  (interactive)
-  (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL"))
-
-;; Used in `ps-rmail-print-article-from-summary',
-;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'.
-(defun ps-print-message-from-summary (summary-buffer summary-default)
-  (let ((ps-buf (or (and (boundp summary-buffer)
-                        (symbol-value summary-buffer))
-                   summary-default)))
-    (and (get-buffer ps-buf)
-        (save-excursion
-          (set-buffer ps-buf)
-          (ps-spool-buffer-with-faces)))))
-
-;; Look in an article or mail message for the Subject: line.  To be
-;; placed in `ps-left-headers'.
-(defun ps-article-subject ()
-  (save-excursion
-    (goto-char (point-min))
-    (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
-       (buffer-substring (match-beginning 1) (match-end 1))
-      "Subject ???")))
-
-;; Look in an article or mail message for the From: line.  Sorta-kinda
-;; understands RFC-822 addresses and can pull the real name out where
-;; it's provided.  To be placed in `ps-left-headers'.
-(defun ps-article-author ()
-  (save-excursion
-    (goto-char (point-min))
-    (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
-       (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
-         (cond
-
-          ;; Try first to match addresses that look like
-          ;; thompson@wg2.waii.com (Jim Thompson)
-          ((string-match ".*[ \t]+(\\(.*\\))" fromstring)
-           (substring fromstring (match-beginning 1) (match-end 1)))
-
-          ;; Next try to match addresses that look like
-          ;; Jim Thompson <thompson@wg2.waii.com> or
-          ;; "Jim Thompson" <thompson@wg2.waii.com>
-          ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)
-           (substring fromstring (match-beginning 2) (match-end 2)))
-
-          ;; Couldn't find a real name -- show the address instead.
-          (t fromstring)))
-      "From ???")))
-
-;; A hook to bind to `gnus-article-prepare-hook'.  This will set the
-;; `ps-left-headers' specially for gnus articles.  Unfortunately,
-;; `gnus-article-mode-hook' is called only once, the first time the *Article*
-;; buffer enters that mode, so it would only work for the first time
-;; we ran gnus.  The second time, this hook wouldn't get set up.  The
-;; only alternative is `gnus-article-prepare-hook'.
-(defun ps-gnus-article-prepare-hook ()
-  (setq ps-header-lines 3
-       ps-left-header
-       ;; The left headers will display the article's subject, its
-       ;; author, and the newsgroup it was in.
-       '(ps-article-subject ps-article-author gnus-newsgroup-name)))
-
-;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the
-;; `ps-left-headers' specially for mail messages.
-(defun ps-vm-mode-hook ()
-  (local-set-key [(f22)] 'ps-vm-print-message-from-summary)
-  (setq ps-header-lines 3
-       ps-left-header
-       ;; The left headers will display the message's subject, its
-       ;; author, and the name of the folder it was in.
-       '(ps-article-subject ps-article-author buffer-name)))
-
-;; Every now and then I forget to switch from the *Summary* buffer to
-;; the *Article* before hitting prsc, and a nicely formatted list of
-;; article subjects shows up at the printer.  This function, bound to
-;; prsc for the gnus *Summary* buffer means I don't have to switch
-;; buffers first.
-;; sb:  Updated for Gnus 5.
-(defun ps-gnus-print-article-from-summary ()
-  (interactive)
-  (ps-print-message-from-summary 'gnus-article-buffer "*Article*"))
-
-;; See `ps-gnus-print-article-from-summary'.  This function does the
-;; same thing for vm.
-(defun ps-vm-print-message-from-summary ()
-  (interactive)
-  (ps-print-message-from-summary 'vm-mail-buffer ""))
-
-;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind
-;; prsc.
-(defun ps-gnus-summary-setup ()
-  (local-set-key [(f22)] 'ps-gnus-print-article-from-summary))
-
-;; Look in an article or mail message for the Subject: line.  To be
-;; placed in `ps-left-headers'.
-(defun ps-info-file ()
-  (save-excursion
-    (goto-char (point-min))
-    (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
-       (buffer-substring (match-beginning 1) (match-end 1))
-      "File ???")))
-
-;; Look in an article or mail message for the Subject: line.  To be
-;; placed in `ps-left-headers'.
-(defun ps-info-node ()
-  (save-excursion
-    (goto-char (point-min))
-    (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
-       (buffer-substring (match-beginning 1) (match-end 1))
-      "Node ???")))
-
-(defun ps-info-mode-hook ()
-  (setq ps-left-header
-       ;; The left headers will display the node name and file name.
-       '(ps-info-node ps-info-file)))
-
-;; WARNING! The following function is a *sample* only, and is *not*
-;; meant to be used as a whole unless you understand what the effects
-;; will be!  (In fact, this is a copy of Jim's setup for ps-print --
-;; I'd be very surprised if it was useful to *anybody*, without
-;; modification.)
-
-(defun ps-jts-ps-setup ()
-  (global-set-key [(f22)] 'ps-spool-buffer-with-faces) ;f22 is prsc
-  (global-set-key [(shift f22)] 'ps-spool-region-with-faces)
-  (global-set-key [(control f22)] 'ps-despool)
-  (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
-  (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
-  (add-hook 'vm-mode-hook 'ps-vm-mode-hook)
-  (add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
-  (add-hook 'Info-mode-hook 'ps-info-mode-hook)
-  (setq ps-spool-duplex t
-       ps-print-color-p nil
-       ps-lpr-command "lpr"
-       ps-lpr-switches '("-Jjct,duplex_long"))
-  'ps-jts-ps-setup)
-
-;; WARNING! The following function is a *sample* only, and is *not*
-;; meant to be used as a whole unless it corresponds to your needs.
-;; (In fact, this is a copy of Jack's setup for ps-print --
-;; I would not be that surprised if it was useful to *anybody*,
-;; without modification.)
-
-(defun ps-jack-setup ()
-  (setq ps-print-color-p  nil
-       ps-lpr-command    "lpr"
-       ps-lpr-switches   nil
-
-       ps-paper-type        'a4
-       ps-landscape-mode    t
-       ps-number-of-columns 2
-
-       ps-left-margin   (/ (* 72  1.0) 2.54) ;  1.0 cm
-       ps-right-margin  (/ (* 72  1.0) 2.54) ;  1.0 cm
-       ps-inter-column  (/ (* 72  1.0) 2.54) ;  1.0 cm
-       ps-bottom-margin (/ (* 72  1.5) 2.54) ;  1.5 cm
-       ps-top-margin    (/ (* 72  1.5) 2.54) ;  1.5 cm
-       ps-header-offset (/ (* 72  1.0) 2.54) ;  1.0 cm
-       ps-header-line-pad    .15
-       ps-print-header       t
-       ps-print-header-frame t
-       ps-header-lines       2
-       ps-show-n-of-n        t
-       ps-spool-duplex       nil
-
-       ps-font-family             'Courier
-       ps-font-size               5.5
-       ps-header-font-family      'Helvetica
-       ps-header-font-size        6
-       ps-header-title-font-size  8)
-  'ps-jack-setup)
-
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; To make this file smaller, some commands go in a separate file.
 ;; But autoload them here to make the separation invisible.
 \f
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; To make this file smaller, some commands go in a separate file.
 ;; But autoload them here to make the separation invisible.
 \f
-;;;### (autoloads (ps-mule-begin-page ps-mule-begin-job ps-mule-encode-header-string
-;;;;;;  ps-mule-initialize ps-mule-plot-composition ps-mule-plot-string
-;;;;;;  ps-mule-set-ascii-font ps-mule-prepare-ascii-font ps-multibyte-buffer)
-;;;;;;  "ps-mule" "ps-mule.el" "586d0a4deeb89be9b80cc01def34481c")
+;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize
+;;;;;;  ps-multibyte-buffer) "ps-mule" "ps-mule.el" "ba0ba38bf1f9831ca12701290fd4b211")
 ;;; Generated autoloads from ps-mule.el
 
 (defvar ps-multibyte-buffer nil "\
 ;;; Generated autoloads from ps-mule.el
 
 (defvar ps-multibyte-buffer nil "\
@@ -7100,71 +6660,21 @@ Valid values are:
 
 Any other value is treated as nil.")
 
 
 Any other value is treated as nil.")
 
-(custom-autoload (quote ps-multibyte-buffer) "ps-mule" t)
-
-(autoload (quote ps-mule-prepare-ascii-font) "ps-mule" "\
-Setup special ASCII font for STRING.
-STRING should contain only ASCII characters.
-
-\(fn STRING)" nil nil)
-
-(autoload (quote ps-mule-set-ascii-font) "ps-mule" "\
-Not documented
-
-\(fn)" nil nil)
-
-(autoload (quote ps-mule-plot-string) "ps-mule" "\
-Generate PostScript code for plotting characters in the region FROM and TO.
-
-It is assumed that all characters in this region belong to the same charset.
+(custom-autoload 'ps-multibyte-buffer "ps-mule" t)
 
 
-Optional argument BG-COLOR specifies background color.
-
-Returns the value:
-
-       (ENDPOS . RUN-WIDTH)
-
-Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
-the sequence.
-
-\(fn FROM TO &optional BG-COLOR)" nil nil)
-
-(autoload (quote ps-mule-plot-composition) "ps-mule" "\
-Generate PostScript code for plotting composition in the region FROM and TO.
-
-It is assumed that all characters in this region belong to the same
-composition.
-
-Optional argument BG-COLOR specifies background color.
-
-Returns the value:
-
-       (ENDPOS . RUN-WIDTH)
-
-Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
-the sequence.
-
-\(fn FROM TO &optional BG-COLOR)" nil nil)
-
-(autoload (quote ps-mule-initialize) "ps-mule" "\
+(autoload 'ps-mule-initialize "ps-mule" "\
 Initialize global data for printing multi-byte characters.
 
 \(fn)" nil nil)
 
 Initialize global data for printing multi-byte characters.
 
 \(fn)" nil nil)
 
-(autoload (quote ps-mule-encode-header-string) "ps-mule" "\
-Generate PostScript code for ploting STRING by font FONTTAG.
-FONTTAG should be a string \"/h0\" or \"/h1\".
-
-\(fn STRING FONTTAG)" nil nil)
-
-(autoload (quote ps-mule-begin-job) "ps-mule" "\
+(autoload 'ps-mule-begin-job "ps-mule" "\
 Start printing job for multi-byte chars between FROM and TO.
 It checks if all multi-byte characters in the region are printable or not.
 
 \(fn FROM TO)" nil nil)
 
 Start printing job for multi-byte chars between FROM and TO.
 It checks if all multi-byte characters in the region are printable or not.
 
 \(fn FROM TO)" nil nil)
 
-(autoload (quote ps-mule-begin-page) "ps-mule" "\
-Not documented
+(autoload 'ps-mule-end-job "ps-mule" "\
+Finish printing job for multi-byte chars.
 
 \(fn)" nil nil)
 
 
 \(fn)" nil nil)