Fix previous change.

[gnu-emacs] / lisp / ps-print.el

diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 576746ce0854f5c62db341bfe9cdc4545bc62766..6f18fd6857e4a94b4a07b8355ea1935072e8085e 100644 (file)
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -7,11 +7,11 @@
 ;; Author:     Vinicius Jose Latorre <vinicius@cpqd.com.br>
 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
 ;; Keywords:   print, PostScript
 ;; Author:     Vinicius Jose Latorre <vinicius@cpqd.com.br>
 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
 ;; Keywords:   print, PostScript

-;; Time-stamp: <98/03/06 11:14:08 vinicius>
-;; Version:    3.06
+;; Time-stamp: <98/06/04  15:23:12 vinicius>
+;; Version:    3.06.3

 
 

-(defconst ps-print-version "3.06"
-  "ps-print.el, v 3.06 <98/03/06 vinicius>
+(defconst ps-print-version "3.06.3"
+  "ps-print.el, v 3.06.3 <98/06/04 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,
 
 Vinicius's last change version -- this file may have been edited as part of
 Emacs without changes to the version number.  When reporting bugs,


@@ -371,21 +371,30 @@ Please send all bug fixes and enhancements to
 ;;
 ;; The variable `ps-print-control-characters' specifies whether you want to see
 ;; a printable form for control and 8-bit characters, that is, instead of
 ;;
 ;; The variable `ps-print-control-characters' specifies whether you want to see
 ;; a printable form for control and 8-bit characters, that is, instead of

-;; sending, for example, a ^D (\005) to printer, it is sent the string "^D".
+;; sending, for example, a ^D (\004) to printer, it is sent the string "^D".

 ;;
 ;; Valid values for `ps-print-control-characters' are:
 ;;
 ;;
 ;; Valid values for `ps-print-control-characters' are:
 ;;

-;;  '8-bit          printable form for control and 8-bit characters
-;;                  (characters from \000 to \037 and \177 to \377).
-;;  'control-8-bit  printable form for control and *control* 8-bit characters
-;;                 (characters from \000 to \037 and \177 to \237).
-;;  'control        printable form for control character
-;;                 (characters from \000 to \037 and \177).
-;;  nil             raw character (no printable form).
+;;  8-bit           This is the value to use when you want an ascii encoding of
+;;                  any control or non-ascii character. Control characters are
+;;                  encoded as "^D", and non-ascii characters have an
+;;                  octal encoding.
+;;
+;;  control-8-bit   This is the value to use when you want an ascii encoding of
+;;                  any control character, whether it is 7 or 8-bit.
+;;                  European 8-bits accented characters are printed according
+;;                  the current font.
+;;
+;;  control         Only ascii control characters have an ascii encoding.
+;;                  European 8-bits accented characters are printed according
+;;                  the current font.
+;;
+;;  nil             No ascii encoding. Any character is printed according the
+;;                  current font.

 ;;
 ;; Any other value is treated as nil.
 ;;
 ;;
 ;; Any other value is treated as nil.
 ;;

-;; The default is 'control-8-bit.
+;; The default is `control-8-bit'.

 ;;
 ;; Characters TAB, NEWLINE and FORMFEED are always treated by ps-print engine.
 ;;
 ;;
 ;; Characters TAB, NEWLINE and FORMFEED are always treated by ps-print engine.
 ;;


@@ -811,19 +820,26 @@ Please send all bug fixes and enhancements to
 ;; Acknowledgements
 ;; ----------------
 ;;
 ;; Acknowledgements
 ;; ----------------
 ;;

+;; Thanks to Roland Ducournau <ducour@lirmm.fr> for
+;; `ps-print-control-characters' variable documentation.
+;;

 ;; Thanks to Marcus G Daniels <marcus@cathcart.sysc.pdx.edu> for a better
 ;; database font management.
 ;;
 ;; Thanks to Martin Boyer <gamin@videotron.ca> for some ideas on putting one
 ;; Thanks to Marcus G Daniels <marcus@cathcart.sysc.pdx.edu> for a better
 ;; database font management.
 ;;
 ;; Thanks to Martin Boyer <gamin@videotron.ca> for some ideas on putting one

-;; header per page over the columns.
+;; header per page over the columns and correct line numbers when printing a
+;; region.

 ;;
 ;; Thanks to Steven L Baur <steve@miranova.com> for dynamic evaluation at
 ;; print time of `ps-lpr-switches'.
 ;;
 ;;
 ;; Thanks to Steven L Baur <steve@miranova.com> for dynamic evaluation at
 ;; print time of `ps-lpr-switches'.
 ;;

+;; Thanks to Kevin Rodgers <kevinr@ihs.com> for handling control characters
+;; (his code was severely modified, but the main idea was kept).
+;;

 ;; Thanks to some suggestions on:
 ;;  * Face color map: Marco Melgazzi <marco@techie.com>
 ;;  * XEmacs compatibility: William J. Henney <will@astrosmo.unam.mx>
 ;; Thanks to some suggestions on:
 ;;  * Face color map: Marco Melgazzi <marco@techie.com>
 ;;  * XEmacs compatibility: William J. Henney <will@astrosmo.unam.mx>

-;;  * Check ps-paper-type: Sudhakar Frederick <sfrederi@asc.corp.mot.com>
+;;  * Check `ps-paper-type': Sudhakar Frederick <sfrederi@asc.corp.mot.com>

 ;;
 ;; Thanks to Jacques Duthen <duthen@cegelec-red.fr> (Jack) for the 3.4 version
 ;; I started from. [vinicius]
 ;;
 ;; Thanks to Jacques Duthen <duthen@cegelec-red.fr> (Jack) for the 3.4 version
 ;; I started from. [vinicius]


@@ -856,9 +872,6 @@ Please send all bug fixes and enhancements to
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile
-  (require 'cl))
-

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


@@ -910,6 +923,30 @@ Please send all bug fixes and enhancements to
   :group 'faces)
 
 
   :group 'faces)
 
 

+(defcustom ps-printer-name printer-name
+  "*The name of a local printer for printing PostScript files.
+
+On Unix-like systems, a string value should be a name understood by
+lpr's -P option; otherwise the value should be nil.
+
+On MS-DOS and MS-Windows systems, if the value is a string, then it is
+taken as the name of the device to which PostScript files are written.
+By default it is the same as `printer-name'; typical non-default
+settings would be \"LPT1\" to \"LPT3\" for parallel printers, or
+\"COM1\" to \"COM4\" or \"AUX\" for serial printers, or
+\"//hostname/printer\" for a shared network printer.  You can also set
+it to a name of a file, in which case the output gets appended to that
+file.  \(Note that `ps-print' package already has facilities for
+printing to a file, so you might as well use them instead of changing
+the setting of this variable.\) If you want to silently discard the
+printed output, set this to \"NUL\".
+
+On DOS/Windows, if the value is anything but a string, PostScript files
+will be piped to the program given by `ps-lpr-command', with switches
+given by `ps-lpr-switches', which see."
+  :type '(choice file (other :tag "Pipe to ps-lpr-command" pipe))
+  :group 'ps-print)
+

 (defcustom ps-lpr-command lpr-command
   "*The shell command for printing a PostScript file."
   :type 'string
 (defcustom ps-lpr-command lpr-command
   "*The shell command for printing a PostScript file."
   :type 'string


@@ -981,17 +1018,31 @@ example `letter', `legal' or `a4'."
 
 (defcustom ps-print-control-characters 'control-8-bit
   "*Specifies the printable form for control and 8-bit characters.
 
 (defcustom ps-print-control-characters 'control-8-bit
   "*Specifies the printable form for control and 8-bit characters.

+That is, instead of sending, for example, a ^D (\004) to printer,
+you can send ^ and D.
+

 Valid values are:
 Valid values are:

-  '8-bit          printable form for control and 8-bit characters
-                  (characters from \000 to \037 and \177 to \377).
-  'control-8-bit  printable form for control and *control* 8-bit characters
-                  (characters from \000 to \037 and \177 to \237).
-  'control        printable form for control character
-                  (characters from \000 to \037 and \177).
-  nil             raw character (no printable form).
+
+  `8-bit'         This is the value to use when you want an ASCII encoding of
+                  any control or non-ASCII character.  Control characters are
+                  encoded as \"^D\", and non-ascii characters have an
+                  octal encoding.
+
+  `control-8-bit' This is the value to use when you want an ASCII encoding of
+                  any control character, whether it is 7 or 8-bit.
+                  European 8-bits accented characters are printed according
+                  the current font.
+
+  `control'       Only ascii control characters have an ASCII encoding.
+                  European 8-bits accented characters are printed according
+                  the current font.
+
+  nil             No ASCII encoding.  Any character is printed according the
+                  current font.
+

 Any other value is treated as nil."
   :type '(choice (const 8-bit) (const control-8-bit)
 Any other value is treated as nil."
   :type '(choice (const 8-bit) (const control-8-bit)

-                (const control) (const nil))
+                (const control) (other :tag "nil" nil))

   :group 'ps-print)
 
 (defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
   :group 'ps-print)
 
 (defcustom ps-number-of-columns (if ps-landscape-mode 2 1)


@@ -1373,8 +1424,7 @@ You can get all the fonts of YOUR printer using `ReportAllFontInfo'."
   :group 'ps-print-font)
 
 (defcustom ps-header-title-font-size (if ps-landscape-mode 12 14)
   :group 'ps-print-font)
 
 (defcustom ps-header-title-font-size (if ps-landscape-mode 12 14)

-  "Font size, in points, for the top line of text in the header,
-when generating PostScript."
+  "Font size, in points, for the top line of text in header, in PostScript."

   :type 'number
   :group 'ps-print-font)
 
   :type 'number
   :group 'ps-print-font)
 


@@ -1502,7 +1552,7 @@ about its setting, though."
 
 If this variable is non-nil, ps-print will rebuild its internal
 reference lists of bold and italic faces *every* time one of the
 
 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
+...-with-faces commands is called.  Most users shouldn't need to set this

 variable."
   :type 'boolean
   :group 'ps-print-face)
 variable."
   :type 'boolean
   :group 'ps-print-face)


@@ -1637,7 +1687,7 @@ The table depends on the current ps-print setup."
 
 ;;;###autoload
 (defun ps-setup ()
 
 ;;;###autoload
 (defun ps-setup ()

-  "Return the current setup."
+  "Return the current PostScript-generation setup."

   (format
    "
 \(setq ps-print-color-p  %s
   (format
    "
 \(setq ps-print-color-p  %s


@@ -2039,19 +2089,23 @@ StandardEncoding 46 82 getinterval aload pop
 
 % stack:  --
 /doLineNumber {
 
 % stack:  --
 /doLineNumber {

-  currentfont
-  gsave
-  0.0 0.0 0.0 setrgbcolor
-  /L0 findfont setfont
-  LineNumber Lines ge
-    {(end      )}
-    {LineNumber 6 string cvs (      ) strcat}
-  ifelse
-  dup stringwidth pop neg 0 rmoveto
-  show
-  grestore
-  setfont
-  /LineNumber LineNumber 1 add def
+  /LineNumber where
+  {
+    pop
+    currentfont
+    gsave
+    0.0 0.0 0.0 setrgbcolor
+    /L0 findfont setfont
+    LineNumber Lines ge
+      {(end      )}
+      {LineNumber 6 string cvs (      ) strcat}
+    ifelse
+    dup stringwidth pop neg 0 rmoveto
+    show
+    grestore
+    setfont
+    /LineNumber LineNumber 1 add def
+  } if

 } def
 
 % stack: --
 } def
 
 % stack: --


@@ -2368,6 +2422,7 @@ StandardEncoding 46 82 getinterval aload pop
 (defvar ps-output-head nil)
 (defvar ps-output-tail nil)
 
 (defvar ps-output-head nil)
 (defvar ps-output-tail nil)
 

+(defvar ps-page-postscript 0)

 (defvar ps-page-count 0)
 (defvar ps-showline-count 1)
 
 (defvar ps-page-count 0)
 (defvar ps-showline-count 1)
 


@@ -2401,8 +2456,8 @@ StandardEncoding 46 82 getinterval aload pop
 ;; it'll do for now.
 
 (defvar ps-header-pad 0
 ;; it'll do for now.
 
 (defvar ps-header-pad 0

-  "Vertical and horizontal space in points (1/72 inch) between the header frame
-and the text it contains.")
+  "Vertical and horizontal space between the header frame and the text.
+This is in units of points (1/72 inch).")

 
 ;; Define accessors to the dimensions list.
 
 
 ;; Define accessors to the dimensions list.
 


@@ -2488,7 +2543,7 @@ See `ps-extend-face' for documentation."
 (defun ps-extend-face (face-extension &optional merge-p)
   "Extend face in `ps-print-face-extension-alist'.
 
 (defun ps-extend-face (face-extension &optional merge-p)
   "Extend face in `ps-print-face-extension-alist'.
 

-If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
+If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged

 with face extensions in `ps-print-face-extension-alist'; otherwise, overrides.
 
 The elements of FACE-EXTENSION list have the form:
 with face extensions in `ps-print-face-extension-alist'; otherwise, overrides.
 
 The elements of FACE-EXTENSION list have the form:


@@ -2554,7 +2609,9 @@ If EXTENSION is any other symbol, it is ignored."
        (boundp 'font-lock-face-attributes)
        (let ((face-attributes font-lock-face-attributes))
         (while face-attributes
        (boundp 'font-lock-face-attributes)
        (let ((face-attributes font-lock-face-attributes))
         (while face-attributes

-          (let* ((face-attribute (pop face-attributes))
+          (let* ((face-attribute
+                  (car (prog1 face-attributes
+                         (setq face-attributes (cdr face-attributes)))))

                  (face (car face-attribute)))
             ;; Rustle up a `defface' SPEC from a
             ;; `font-lock-face-attributes' entry.
                  (face (car face-attribute)))
             ;; Rustle up a `defface' SPEC from a
             ;; `font-lock-face-attributes' entry.


@@ -2620,7 +2677,7 @@ If EXTENSION is any other symbol, it is ignored."
 
 
 (defvar ps-printing-region nil
 
 
 (defvar ps-printing-region nil

-  "Variable used to indicate if it is printing a region.
+  "Variable used to indicate if ps-print is printing a region.

 If non-nil, 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
 If non-nil, 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


@@ -2638,22 +2695,22 @@ and to indicate in the header that the printout is of a partial file.")
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Internal functions
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Internal functions
 

-(defsubst ps-font-list (font-sym)
+(defsubst ps-font-alist (font-sym)

   (get font-sym 'fonts))
 
 (defun ps-font (font-sym font-type)
   "Font family name for text of `font-type', when generating PostScript."
   (get font-sym 'fonts))
 
 (defun ps-font (font-sym font-type)
   "Font family name for text of `font-type', when generating PostScript."

-  (let* ((font-list (ps-font-list font-sym))
+  (let* ((font-list (ps-font-alist font-sym))

         (normal-font (cdr (assq 'normal font-list))))
         (normal-font (cdr (assq 'normal font-list))))

-    (loop for font in font-list do
-         (when (eq font-type (car font))
-           (return (or (cdr font) normal-font))))))
+    (while (and font-list (not (eq font-type (car (car font-list)))))
+      (setq font-list (cdr font-list)))
+    (or (cdr (car font-list)) normal-font)))

 
 (defun ps-fonts (font-sym)
 
 (defun ps-fonts (font-sym)

-  (loop for font in (ps-font-list font-sym) collect (cdr font)))
+  (mapcar 'cdr (ps-font-alist font-sym)))

 
 (defun ps-font-number (font-sym font-type)
 
 (defun ps-font-number (font-sym font-type)

-  (or (position font-type (ps-font-list font-sym) :key 'car)
+  (or (ps-alist-position font-type (ps-font-alist font-sym))

       0))
 
 (defsubst ps-line-height (font-sym)
       0))
 
 (defsubst ps-line-height (font-sym)


@@ -2723,9 +2780,9 @@ Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
     (display-buffer buf 'not-this-window)))
 
 (defun ps-nb-pages (nb-lines)
     (display-buffer buf 'not-this-window)))
 
 (defun ps-nb-pages (nb-lines)

-  "Display an approximate correspondence between a font size and the number
-of pages the number of lines would require to print
-using the current ps-print setup."
+  "Display correspondence between font size and the number of pages.
+The correspondence is based on having NB-LINES lines of text,
+and on the current ps-print setup."

   (let ((buf (get-buffer-create "*Nb-Pages*"))
        (ifs ps-font-size)              ; initial font size
        (ilh (ps-line-height 'ps-font-for-text)) ; initial line height
   (let ((buf (get-buffer-create "*Nb-Pages*"))
        (ifs ps-font-size)              ; initial font size
        (ilh (ps-line-height 'ps-font-for-text)) ; initial line height


@@ -2767,21 +2824,23 @@ using the current ps-print setup."
     (insert "\n")
     (display-buffer buf 'not-this-window)))
 
     (insert "\n")
     (display-buffer buf 'not-this-window)))
 

+;; macros used in `ps-select-font'
+(defmacro ps-lookup (key) `(cdr (assq ,key font-entry)))
+(defmacro ps-size-scale (key) `(/ (* (ps-lookup ,key) font-size) size))
+

 (defun ps-select-font (font-family sym font-size title-font-size)
   (let ((font-entry (cdr (assq font-family ps-font-info-database))))
     (or font-entry
        (error "Don't have data to scale font %s. Known fonts families are %s"
               font-family
               (mapcar 'car ps-font-info-database)))
 (defun ps-select-font (font-family sym font-size title-font-size)
   (let ((font-entry (cdr (assq font-family ps-font-info-database))))
     (or font-entry
        (error "Don't have data to scale font %s. Known fonts families are %s"
               font-family
               (mapcar 'car ps-font-info-database)))

-    (flet ((lookup (key) (cdr (assq key font-entry))))
-      (let ((size (lookup 'size)))
-       (put sym 'fonts (lookup 'fonts))
-       (flet ((size-scale (key) (/ (* (lookup key) font-size) size)))
-         (put sym 'space-width (size-scale 'space-width))
-         (put sym 'avg-char-width (size-scale 'avg-char-width))
-         (put sym 'line-height (size-scale 'line-height))
-         (put sym 'title-line-height
-              (/ (* (lookup 'line-height) title-font-size) size)))))))
+    (let ((size (ps-lookup 'size)))
+      (put sym 'fonts (ps-lookup 'fonts))
+      (put sym 'space-width (ps-size-scale 'space-width))
+      (put sym 'avg-char-width (ps-size-scale 'avg-char-width))
+      (put sym 'line-height (ps-size-scale 'line-height))
+      (put sym 'title-line-height
+          (/ (* (ps-lookup 'line-height) title-font-size) size)))))

 
 (defun ps-get-page-dimensions ()
   (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
 
 (defun ps-get-page-dimensions ()
   (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))


@@ -2927,10 +2986,14 @@ page-height == bm + print-height + tm - ho - hh
   (save-excursion                      ;insert string
     (insert string))
   ;; Find and quote special characters as necessary for PS
   (save-excursion                      ;insert string
     (insert string))
   ;; Find and quote special characters as necessary for PS

-  (while (re-search-forward "[\000-\037\177-\377()\\]" nil t)
-    (let ((special (preceding-char)))
-      (delete-char -1)
-      (insert (aref ps-string-escape-codes special))))
+  ;; This skips everything except control chars, nonascii chars,
+  ;; (, ) and \.
+  (while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))
+    (let ((special (following-char)))
+      (if (> (char-bytes special) 1)
+         (forward-char)
+       (delete-char 1)
+       (insert (aref ps-string-escape-codes special)))))

   (goto-char (point-max))
   (insert ")"))                                ;insert end-string delimiter
 
   (goto-char (point-max))
   (insert ")"))                                ;insert end-string delimiter
 


@@ -3140,9 +3203,32 @@ page-height == bm + print-height + tm - ho - hh
     (and has-local-background (ps-output "} def\n"))))
 
 
     (and has-local-background (ps-output "} def\n"))))
 
 

+;; Return a list of the distinct elements of LIST.
+;; Elements are compared with `equal'.
+(defun ps-remove-duplicates (list)
+  (let (new (tail list))
+    (while tail
+      (or (member (car tail) new)
+         (setq new (cons (car tail) new)))
+      (setq tail (cdr tail)))
+    (nreverse new)))
+
+;; Find the first occurrence of ITEM in LIST.
+;; Return the index of the matching item, or nil if not found.
+;; Elements are compared with `eq'.
+(defun ps-alist-position (item list)
+  (let ((tail list) (index 0) found)
+    (while tail
+      (if (setq found (eq (car (car tail)) item))
+         (setq tail nil)
+       (setq index (1+ index)
+             tail (cdr tail))))
+    (and found index)))
+
+

 (defun ps-begin-file ()
   (ps-get-page-dimensions)
 (defun ps-begin-file ()
   (ps-get-page-dimensions)

-  (setq ps-showline-count (if ps-printing-region (car ps-printing-region) 1)
+  (setq ps-page-postscript 0

        ps-background-text-count 0
        ps-background-image-count 0
        ps-background-pages nil
        ps-background-text-count 0
        ps-background-image-count 0
        ps-background-pages nil


@@ -3159,11 +3245,10 @@ page-height == bm + print-height + tm - ho - hh
             (if ps-landscape-mode "Landscape" "Portrait")
             "\n%% DocumentFonts: Times-Roman Times-Italic "
             (mapconcat 'identity
             (if ps-landscape-mode "Landscape" "Portrait")
             "\n%% DocumentFonts: Times-Roman Times-Italic "
             (mapconcat 'identity

-                       (remove-duplicates
+                       (ps-remove-duplicates

                         (append (ps-fonts 'ps-font-for-text)
                                 (list (ps-font 'ps-font-for-header 'normal)
                         (append (ps-fonts 'ps-font-for-text)
                                 (list (ps-font 'ps-font-for-header 'normal)

-                                      (ps-font 'ps-font-for-header 'bold)))
-                        :test 'equal)
+                                      (ps-font 'ps-font-for-header 'bold))))

                        " ")
             "\n%%Pages: (atend)\n"
             "%%EndComments\n\n")
                        " ")
             "\n%%Pages: (atend)\n"
             "%%EndComments\n\n")


@@ -3203,14 +3288,7 @@ page-height == bm + print-height + tm - ho - hh
 
   (ps-output-boolean "Zebra" ps-zebra-stripes)
   (ps-output-boolean "PrintLineNumber" ps-line-number)
 
   (ps-output-boolean "Zebra" ps-zebra-stripes)
   (ps-output-boolean "PrintLineNumber" ps-line-number)

-  (ps-output (format "/ZebraHeight %d def\n" ps-zebra-stripe-height)
-            (format "/Lines %d def\n"
-                    (if ps-printing-region
-                        (cdr ps-printing-region)
-                      (ps-count-lines (point-min) (point-max))))
-            "/PageCount 0 def\n")      ; set total page number
-                                       ; when printing has finished
-                                       ; (see `ps-generate')
+  (ps-output (format "/ZebraHeight %d def\n" ps-zebra-stripe-height))

 
   (ps-background-text)
   (ps-background-image)
 
   (ps-background-text)
   (ps-background-image)


@@ -3234,13 +3312,15 @@ page-height == bm + print-height + tm - ho - hh
   (ps-output ps-print-prologue-2)
 
   ;; Text fonts
   (ps-output ps-print-prologue-2)
 
   ;; Text fonts

-  (loop for font in (ps-font-list 'ps-font-for-text)
-       for i from 0
-       do
-       (ps-output (format "/f%d %s /%s DefFont\n"
-                          i
-                          ps-font-size
-                          (ps-font 'ps-font-for-text (car font)))))
+  (let ((font (ps-font-alist 'ps-font-for-text))
+       (i 0))
+    (while font
+      (ps-output (format "/f%d %s /%s DefFont\n"
+                        i
+                        ps-font-size
+                        (ps-font 'ps-font-for-text (car (car font)))))
+      (setq font (cdr font)
+           i (1+ i))))

 
   (ps-output "\nBeginDoc\n\n"
             "%%EndPrologue\n"))
 
   (ps-output "\nBeginDoc\n\n"
             "%%EndPrologue\n"))


@@ -3267,7 +3347,13 @@ page-height == bm + print-height + tm - ho - hh
        (and (buffer-modified-p) " (unsaved)")))))
 
 (defun ps-begin-job ()
        (and (buffer-modified-p) " (unsaved)")))))
 
 (defun ps-begin-job ()

-  (setq ps-page-count 0
+  (save-excursion
+    (set-buffer ps-spool-buffer)
+    (goto-char (point-max))
+    (and (re-search-backward "^%%Trailer$" nil t)
+        (delete-region (match-beginning 0) (point-max))))
+  (setq ps-showline-count (if ps-printing-region (car ps-printing-region) 1)
+       ps-page-count 0

        ps-control-or-escape-regexp
        (cond ((eq ps-print-control-characters '8-bit)
               "[\000-\037\177-\377]")
        ps-control-or-escape-regexp
        (cond ((eq ps-print-control-characters '8-bit)
               "[\000-\037\177-\377]")


@@ -3281,9 +3367,9 @@ page-height == bm + print-height + tm - ho - hh
   `(1+ (/ (1- ps-page-count) ps-number-of-columns)))
 
 (defun ps-end-file ()
   `(1+ (/ (1- ps-page-count) ps-number-of-columns)))
 
 (defun ps-end-file ()

-  (ps-output "\nEndDoc\n\n%%Trailer\n%%Pages: "
-            (format "%d" (ps-page-number))
-            "\n%%EOF\n"))
+  (ps-output "\n%%Trailer\n%%Pages: "
+            (format "%d" ps-page-postscript)
+            "\n\nEndDoc\n\n%%EOF\n"))

 
 
 (defun ps-next-page ()
 
 
 (defun ps-next-page ()


@@ -3292,17 +3378,21 @@ page-height == bm + print-height + tm - ho - hh
   (ps-begin-page))
 
 (defun ps-header-page ()
   (ps-begin-page))
 
 (defun ps-header-page ()

+  ;; set total line and page number when printing has finished
+  ;; (see `ps-generate')

   (if (prog1
          (zerop (mod ps-page-count ps-number-of-columns))
   (if (prog1
          (zerop (mod ps-page-count ps-number-of-columns))

-       (incf ps-page-count))
+       (setq ps-page-count (1+ ps-page-count)))

       ;; Print only when a new real page begins.
       ;; Print only when a new real page begins.

-      (let ((page-number (ps-page-number)))
-       (ps-output (format "\n%%%%Page: %d %d\n" page-number page-number))
-       (ps-output "BeginDSCPage\n")
-       (ps-background page-number)
+      (progn
+       (setq ps-page-postscript (1+ ps-page-postscript))
+       (ps-output (format "\n%%%%Page: %d %d\n"
+                          ps-page-postscript ps-page-postscript))
+       (ps-output "/Lines 0 def\n/PageCount 0 def\nBeginDSCPage\n")
+       (ps-background ps-page-postscript)

        (run-hooks 'ps-print-begin-page-hook))
     ;; Print when any other page begins.
        (run-hooks 'ps-print-begin-page-hook))
     ;; Print when any other page begins.

-    (ps-output "BeginDSCPage\n")
+    (ps-output "/Lines 0 def\n/PageCount 0 def\nBeginDSCPage\n")

     (run-hooks 'ps-print-begin-column-hook)))
 
 (defun ps-begin-page ()
     (run-hooks 'ps-print-begin-column-hook)))
 
 (defun ps-begin-page ()


@@ -3845,7 +3935,7 @@ If FACE is not a valid face name, it is used default face."
          (unwind-protect
              (progn
                (set-buffer ps-spool-buffer)
          (unwind-protect
              (progn
                (set-buffer ps-spool-buffer)

-
+               (set-buffer-multibyte nil)

                ;; Get a marker and make it point to the current end of the
                ;; buffer,  If an error occurs, we'll delete everything from
                ;; the end of this marker onwards.
                ;; Get a marker and make it point to the current end of the
                ;; buffer,  If an error occurs, we'll delete everything from
                ;; the end of this marker onwards.


@@ -3866,17 +3956,22 @@ If FACE is not a valid face name, it is used default face."
 
                (and ps-spool-duplex (= (mod ps-page-count 2) 1)
                     (ps-dummy-page))
 
                (and ps-spool-duplex (= (mod ps-page-count 2) 1)
                     (ps-dummy-page))

+               (ps-end-file)

                (ps-flush-output)
 
                ;; Back to the PS output buffer to set the page count
                (ps-flush-output)
 
                ;; Back to the PS output buffer to set the page count

-               (set-buffer ps-spool-buffer)
-               (goto-char (point-min))
-               (and (re-search-forward "^/PageCount 0 def$" nil t)
-                    (replace-match (format "/PageCount %d def"
-                                           (if ps-print-only-one-header
-                                               (ps-page-number)
-                                             ps-page-count))
-                                   t))
+               (let ((total-lines (if ps-printing-region
+                                      (cdr ps-printing-region)
+                                    (ps-count-lines (point-min) (point-max))))
+                     (total-pages (if ps-print-only-one-header
+                                      (ps-page-number)
+                                    ps-page-count)))
+                 (set-buffer ps-spool-buffer)
+                 (goto-char (point-min))
+                 (while (re-search-forward "^/Lines 0 def\n/PageCount 0 def$"
+                                           nil t)
+                   (replace-match (format "/Lines %d def\n/PageCount %d def"
+                                          total-lines total-pages) t)))

 
                ;; Setting this variable tells the unwind form that the
                ;; the PostScript was generated without error.
 
                ;; Setting this variable tells the unwind form that the
                ;; the PostScript was generated without error.


@@ -3898,8 +3993,6 @@ If FACE is not a valid face name, it is used default face."
   (if (or (not (boundp 'ps-spool-buffer))
          (not (symbol-value 'ps-spool-buffer)))
       (message "No spooled PostScript to print")
   (if (or (not (boundp 'ps-spool-buffer))
          (not (symbol-value 'ps-spool-buffer)))
       (message "No spooled PostScript to print")

-    (ps-end-file)
-    (ps-flush-output)

     (if filename
        (save-excursion
          (and ps-razzle-dazzle (message "Saving..."))
     (if filename
        (save-excursion
          (and ps-razzle-dazzle (message "Saving..."))


@@ -3912,11 +4005,23 @@ If FACE is not a valid face name, it is used default face."
       (and ps-razzle-dazzle (message "Printing..."))
       (save-excursion
        (set-buffer ps-spool-buffer)
       (and ps-razzle-dazzle (message "Printing..."))
       (save-excursion
        (set-buffer ps-spool-buffer)

-       (let ((coding-system-for-write 'raw-text-unix))
-         (if (and (eq system-type 'ms-dos)
-                  (stringp (symbol-value 'dos-ps-printer)))
+       (let* ((coding-system-for-write 'raw-text-unix)
+              (ps-printer-name (or ps-printer-name printer-name))
+              (ps-lpr-switches
+               (append
+                (and (stringp ps-printer-name)
+                     (list (concat "-P" ps-printer-name)))
+                ps-lpr-switches)))
+         (if (and (memq system-type '(ms-dos windows-nt))
+                  (or (and (boundp 'dos-ps-printer)
+                           (stringp (symbol-value 'dos-ps-printer)))
+                      (stringp (symbol-value 'ps-printer-name))))

              (write-region (point-min) (point-max)
              (write-region (point-min) (point-max)

-                           (symbol-value 'dos-ps-printer) t 0)
+                           (or (and (boundp 'dos-ps-printer)
+                                    (stringp (symbol-value 'dos-ps-printer))
+                                    (symbol-value 'dos-ps-printer))
+                               (symbol-value 'ps-printer-name))
+                           t 0)

            (apply 'call-process-region
                   (point-min) (point-max) ps-lpr-command nil
                   (and (fboundp 'start-process) 0)
            (apply 'call-process-region
                   (point-min) (point-max) ps-lpr-command nil
                   (and (fboundp 'start-process) 0)