diff lisp/ps-print.el @ 33090:a48e4118492d

Fix bug on selected pages for printing. Use `color-values' for Emacs 21. Ensure fontification when jit-lock is on. Try to avoid warning messages when compiling. Doc Fix. (ps-print-version): New version number (6.3). (ps-color-device): Use `color-values' to determine if device supports color. (ps-color-values): Try to use `x-color-values' when using XEmacs. (ps-print-page-p): Changed from defsubst to defun. (ps-page-number): Changed from defmacro to defun. (ps-header-sheet, ps-header-page): Fix bug on selected pages for printing. (ps-print-ensure-fontified): Ensure fontification when jit-lock is on. (ps-end-file, ps-dummy-page): Funs eliminated. (ps-print-color-scale): Changed default value. (ps-page-n-up, ps-print-page-p): New internal vars. (ps-print-preprint, ps-output, ps-begin-file, ps-begin-page) (ps-plot-region, ps-generate, ps-end-job): Code fix.

--- a/lisp/ps-print.el	Tue Oct 31 06:37:58 2000 +0000
+++ b/lisp/ps-print.el	Tue Oct 31 11:54:01 2000 +0000
@@ -9,12 +9,12 @@
 ;; Maintainer:	Kenichi Handa <[e-mail]> (multi-byte characters)
 ;; Maintainer:	Vinicius Jose Latorre <[e-mail]>
 ;; Keywords:	wp, print, PostScript
-;; Time-stamp:	<2000/10/19 11:54:10 vinicius>
-;; Version:	6.2.1
+;; Time-stamp:	<2000/10/28 23:38:44 Vinicius>
+;; Version:	6.3
 ;; X-URL:	http://www.cpqd.com.br/~vinicius/emacs/
 
-(defconst ps-print-version "6.2.1"
-  "ps-print.el, v 6.2.1 <2000/10/19 vinicius>
+(defconst ps-print-version "6.3"
+  "ps-print.el, v 6.3 <2000/10/28 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
@@ -1301,68 +1301,71 @@
 
 ;;; Code:
 
-(unless (featurep 'lisp-float-type)
-  (error "`ps-print' requires floating point support"))
-
-
-;; For Emacs 20.2 and the earlier version.
-
-(or (fboundp 'set-buffer-multibyte)
-    (defun set-buffer-multibyte (arg)
-      (setq enable-multibyte-characters arg)))
-
-(or (fboundp 'string-as-unibyte)
-    (defun string-as-unibyte (arg) arg))
-
-(or (fboundp 'string-as-multibyte)
-    (defun string-as-multibyte (arg) arg))
-
-(or (fboundp 'char-charset)
-    (defun char-charset (arg) 'ascii))
-
-(or (fboundp 'charset-after)
-    (defun charset-after (&optional arg)
-      (char-charset (char-after arg))))
-
-
-;; GNU Emacs
-(or (fboundp 'line-beginning-position)
-    (defun line-beginning-position (&optional n)
-      (save-excursion
-	(and n (/= n 1) (forward-line (1- n)))
-	(beginning-of-line)
-	(point))))
-
-
-;; to avoid compilation gripes
-
-;; XEmacs
-(defalias 'ps-x-color-instance-p              'color-instance-p)
-(defalias 'ps-x-color-instance-rgb-components 'color-instance-rgb-components)
-(defalias 'ps-x-color-name                    'color-name)
-(defalias 'ps-x-color-specifier-p             'color-specifier-p)
-(defalias 'ps-x-copy-coding-system            'copy-coding-system)
-(defalias 'ps-x-device-class                  'device-class)
-(defalias 'ps-x-extent-end-position           'extent-end-position)
-(defalias 'ps-x-extent-face                   'extent-face)
-(defalias 'ps-x-extent-priority               'extent-priority)
-(defalias 'ps-x-extent-start-position         'extent-start-position)
-(defalias 'ps-x-face-font-instance            'face-font-instance)
-(defalias 'ps-x-find-coding-system            'find-coding-system)
-(defalias 'ps-x-font-instance-properties      'font-instance-properties)
-(defalias 'ps-x-make-color-instance           'make-color-instance)
-(defalias 'ps-x-map-extents                   'map-extents)
-
-;; GNU Emacs
-(if (fboundp 'find-composition)
-    (defalias 'ps-e-find-composition 'find-composition)
-  (defalias 'ps-e-find-composition 'ignore))
-
-
-(defconst ps-windows-system
-  (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
-(defconst ps-lp-system
-  (memq system-type '(usq-unix-v dgux hpux irix)))
+(eval-and-compile
+  (unless (featurep 'lisp-float-type)
+    (error "`ps-print' requires floating point support"))
+
+
+  ;; For Emacs 20.2 and the earlier version.
+
+  (or (fboundp 'set-buffer-multibyte)
+      (defun set-buffer-multibyte (arg)
+	(setq enable-multibyte-characters arg)))
+
+  (or (fboundp 'string-as-unibyte)
+      (defun string-as-unibyte (arg) arg))
+
+  (or (fboundp 'string-as-multibyte)
+      (defun string-as-multibyte (arg) arg))
+
+  (or (fboundp 'char-charset)
+      (defun char-charset (arg) 'ascii))
+
+  (or (fboundp 'charset-after)
+      (defun charset-after (&optional arg)
+	(char-charset (char-after arg))))
+
+
+  ;; GNU Emacs
+  (or (fboundp 'line-beginning-position)
+      (defun line-beginning-position (&optional n)
+	(save-excursion
+	  (and n (/= n 1) (forward-line (1- n)))
+	  (beginning-of-line)
+	  (point))))
+
+
+  ;; to avoid compilation gripes
+
+  ;; XEmacs
+  (defalias 'ps-x-color-instance-p              'color-instance-p)
+  (defalias 'ps-x-color-instance-rgb-components 'color-instance-rgb-components)
+  (defalias 'ps-x-color-name                    'color-name)
+  (defalias 'ps-x-color-specifier-p             'color-specifier-p)
+  (defalias 'ps-x-copy-coding-system            'copy-coding-system)
+  (defalias 'ps-x-device-class                  'device-class)
+  (defalias 'ps-x-extent-end-position           'extent-end-position)
+  (defalias 'ps-x-extent-face                   'extent-face)
+  (defalias 'ps-x-extent-priority               'extent-priority)
+  (defalias 'ps-x-extent-start-position         'extent-start-position)
+  (defalias 'ps-x-face-font-instance            'face-font-instance)
+  (defalias 'ps-x-find-coding-system            'find-coding-system)
+  (defalias 'ps-x-font-instance-properties      'font-instance-properties)
+  (defalias 'ps-x-make-color-instance           'make-color-instance)
+  (defalias 'ps-x-map-extents                   'map-extents)
+
+  ;; GNU Emacs
+  (defalias 'ps-e-x-color-values 'x-color-values)
+  (defalias 'ps-e-color-values   'color-values)
+  (if (fboundp 'find-composition)
+      (defalias 'ps-e-find-composition 'find-composition)
+    (defalias 'ps-e-find-composition 'ignore))
+
+
+  (defconst ps-windows-system
+    (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
+  (defconst ps-lp-system
+    (memq system-type '(usq-unix-v dgux hpux irix))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1722,7 +1725,9 @@
 `ps-selected-pages' is saved in `ps-last-selected-pages' (see it for
 documentation).  So you can restore the latest selected pages by using
 `ps-last-selected-pages' or by calling `ps-restore-selected-pages' command (see
-it for documentation)."
+it for documentation).
+
+See also `ps-even-or-odd-pages'."
   :type '(repeat :tag "Selected Pages"
 		 (radio :tag "Page"
 			(integer :tag "Number")
@@ -1742,7 +1747,20 @@
 
    `odd'	print only odd pages.
 
-Any other value is treated as nil."
+Any other value is treated as nil.
+
+If you set `ps-selected-pages' (see it for documentation), first the pages are
+filtered by `ps-selected-pages' and then by `ps-even-or-odd-pages'.  For
+example, if we have:
+
+   (setq ps-selected-pages '(1 4 (6 . 10) 12))
+
+We have the following results:
+
+   `ps-even-or-odd-pages'	PAGES PRINTED
+	nil			1, 4, 6, 7, 8, 9, 10, 12
+	even			4, 6, 8, 10, 12
+	odd			1, 7, 9"
   :type '(choice :menu-tag "Print Even/Odd Pages"
 		 :tag "Print Even/Odd Pages"
 		 (const :tag "All Pages" nil)
@@ -2415,8 +2433,11 @@
 ;;; Colors
 
 ;; Printing color requires x-color-values.
-(defcustom ps-print-color-p (or (fboundp 'x-color-values) ; Emacs
-				(fboundp 'color-instance-rgb-components))
+(defcustom ps-print-color-p
+  (or (and (fboundp 'color-values)	; Emacs
+	   (ps-e-color-values "Green"))
+      (fboundp 'x-color-values)		; Emacs
+      (fboundp 'color-instance-rgb-components))
 					; XEmacs
   "*Non-nil means print the buffer's text in color."
   :type 'boolean
@@ -2911,17 +2932,18 @@
 
   ;; Return t if the device (which can be changed during an emacs session)
   ;; can handle colors.
-  ;; This is function is not yet implemented for GNU emacs.
+  ;; This function is not yet implemented for GNU emacs.
   (cond ((and (eq ps-print-emacs-type 'xemacs)
 	      (>= emacs-minor-version 12)) ; xemacs
 	 (defun ps-color-device ()
-	   (eq (ps-x-device-class) 'color))
-	 )
+	   (eq (ps-x-device-class) 'color)))
 
 	(t				; emacs
 	 (defun ps-color-device ()
-	   t)
-	 ))
+	   (if (fboundp 'color-values)
+	       (ps-e-color-values "Green")
+	     t))))
+
 
   (defun ps-mapper (extent list)
     (nconc list
@@ -2951,9 +2973,13 @@
   (cond ((eq ps-print-emacs-type 'emacs) ; emacs
 
 	 (defun ps-color-values (x-color)
-	   (if (fboundp 'x-color-values)
-	       (x-color-values x-color)
-	     (error "No available function to determine X color values.")))
+	   (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."))))
 
 	 (defalias 'ps-face-foreground-name 'face-foreground)
 	 (defalias 'ps-face-background-name 'face-background)
@@ -2977,7 +3003,7 @@
 	   (let ((color (ps-xemacs-color-name x-color)))
 	     (cond
 	      ((fboundp 'x-color-values)
-	       (x-color-values color))
+	       (ps-e-x-color-values color))
 	      ((and (fboundp 'color-instance-rgb-components)
 		    (ps-color-device))
 	       (ps-x-color-instance-rgb-components
@@ -3004,7 +3030,7 @@
 	 )))
 
 
-(defvar ps-print-color-scale nil)
+(defvar ps-print-color-scale 1.0)
 
 (defun ps-color-scale (color)
   ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
@@ -3057,9 +3083,11 @@
 (defvar ps-page-postscript 0)
 (defvar ps-page-order 0)
 (defvar ps-page-count 0)
+(defvar ps-page-n-up 0)
 (defvar ps-showline-count 1)
 (defvar ps-first-page nil)
 (defvar ps-last-page nil)
+(defvar ps-print-page-p t)
 
 (defvar ps-control-or-escape-regexp nil)
 (defvar ps-n-up-on nil)
@@ -3614,16 +3642,19 @@
 			      ".ps"))
 	      (prompt (format "Save PostScript to file: (default %s) " name))
 	      (res    (read-file-name prompt default-directory name nil)))
-	 (while (cond ((not (file-writable-p res))
+	 (while (cond ((file-directory-p res)
 		       (ding)
-		       (setq prompt "is unwritable"))
+		       (setq prompt "It's a directory"))
+		      ((not (file-writable-p res))
+		       (ding)
+		       (setq prompt "File is unwritable"))
 		      ((file-exists-p res)
-		       (setq prompt "exists")
+		       (setq prompt "File exists")
 		       (not (y-or-n-p (format "File `%s' exists; overwrite? "
 					      res))))
 		      (t nil))
 	   (setq res (read-file-name
-		      (format "File %s; save PostScript to file: " prompt)
+		      (format "%s; save PostScript to file: " prompt)
 		      (file-name-directory res) nil nil
 		      (file-name-nondirectory res))))
 	 (if (file-directory-p res)
@@ -3691,26 +3722,27 @@
 		(< ps-last-page ps-page-postscript)))))
 
 
-(defsubst ps-print-page-p ()
-  (and (cond ((null ps-first-page))
-	     ((<= ps-page-postscript ps-last-page)
-	      (<= ps-first-page ps-page-postscript))
-	     (ps-selected-pages
-	      (ps-selected-pages)
-	      (and (<= ps-first-page ps-page-postscript)
-		   (<= ps-page-postscript ps-last-page)))
-	     (t
-	      nil))
-       (cond ((eq ps-even-or-odd-pages 'even)
-	      (= (logand ps-page-postscript 1) 0))
-	     ((eq ps-even-or-odd-pages 'odd)
-	      (= (logand ps-page-postscript 1) 1))
-	     (t)
-	     )))
+(defun ps-print-page-p ()
+  (setq ps-print-page-p
+	(and (cond ((null ps-first-page))
+		   ((<= ps-page-postscript ps-last-page)
+		    (<= ps-first-page ps-page-postscript))
+		   (ps-selected-pages
+		    (ps-selected-pages)
+		    (and (<= ps-first-page ps-page-postscript)
+			 (<= ps-page-postscript ps-last-page)))
+		   (t
+		    nil))
+	     (cond ((eq ps-even-or-odd-pages 'even)
+		    (= (logand ps-page-postscript 1) 0))
+		   ((eq ps-even-or-odd-pages 'odd)
+		    (= (logand ps-page-postscript 1) 1))
+		   (t)
+		   ))))
 
 
 (defun ps-output (&rest args)
-  (when (ps-print-page-p)
+  (when ps-print-page-p
     (setcdr ps-output-tail args)
     (while (cdr ps-output-tail)
       (setq ps-output-tail (cdr ps-output-tail)))))
@@ -4388,6 +4420,8 @@
   (ps-get-page-dimensions)
   (setq ps-page-postscript 0
 	ps-page-order 0
+	ps-page-n-up 0
+	ps-print-page-p t
 	ps-background-text-count 0
 	ps-background-image-count 0
 	ps-background-pages nil
@@ -4733,36 +4767,10 @@
 	))
 
 
-(defmacro ps-page-number ()
-  `(1+ (/ (1- ps-page-count) ps-number-of-columns)))
-
-(defun ps-end-file (needs-begin-file)
-  (let (ps-even-or-odd-pages)
-    (ps-flush-output)
-    ;; Back to the PS output buffer to set the last page n-up printing
-    (save-excursion
-      (let ((pages-per-sheet (mod ps-page-postscript ps-n-up-printing))
-	    case-fold-search)
-	(set-buffer ps-spool-buffer)
-	(goto-char (point-max))
-	(and (> pages-per-sheet 0)
-	     (re-search-backward "^[0-9]+ BeginSheet$" nil t)
-	     (replace-match (format "%d BeginSheet" pages-per-sheet) t))))
-    ;; Set dummy page
-    (and ps-spool-duplex (= (mod ps-page-order 2) 1)
-	 (let (ps-first-page)
-	   (ps-dummy-page)))
-    ;; Set end of PostScript file
-    (or ps-first-page
-	(ps-output "EndSheet\n"))
-    (setq ps-first-page nil)		; disable selected pages
-    (ps-output "\n%%Trailer\n%%Pages: "
-	       (format "%d"
-		       (if (and needs-begin-file
-				ps-banner-page-when-duplexing)
-			   (1+ ps-page-order)
-			 ps-page-order))
-	       "\n\nEndDoc\n\n%%EOF\n")))
+(defun ps-page-number ()
+  (if ps-print-only-one-header
+      (1+ (/ (1- ps-page-count) ps-number-of-columns))
+    ps-page-count))
 
 
 (defun ps-next-page ()
@@ -4773,45 +4781,39 @@
 
 (defun ps-header-sheet ()
   ;; Print only when a new sheet begins.
-  (let ((print-posterior (ps-print-page-p)))
-    (setq ps-page-postscript (1+ ps-page-postscript))
-    (cond ((ps-print-page-p)
-	   (setq ps-page-order (1+ ps-page-order))
-	   (and (or print-posterior ps-even-or-odd-pages) (> ps-page-order 1)
-		(ps-output "EndSheet\n"))
-	   (ps-output (if ps-n-up-on
-			  (format "\n%%%%Page: (%d \\(%d\\)) %d\n"
-				  ps-page-order ps-page-postscript ps-page-order)
-			(format "\n%%%%Page: %d %d\n"
-				ps-page-postscript ps-page-order))
-		      (format "%d BeginSheet\nBeginDSCPage\n"
-			      ps-n-up-printing)))
-	  (print-posterior
-	   (let (ps-first-page)
-	     (ps-output "EndSheet\n"))))))
-
-
-(defsubst ps-header-page ()
+  (setq ps-page-order (1+ ps-page-order))
+  (and (> ps-page-order 1)
+       (ps-output "EndSheet\n"))
+  (ps-output (if ps-n-up-on
+		 (format "\n%%%%Page: (%d \\(%d\\)) %d\n"
+			 ps-page-order ps-page-postscript ps-page-order)
+	       (format "\n%%%%Page: %d %d\n"
+		       ps-page-postscript ps-page-order))
+	     (format "%d BeginSheet\nBeginDSCPage\n"
+		     ps-n-up-printing)))
+
+
+(defun ps-header-page ()
   ;; set total line and page number when printing has finished
   ;; (see `ps-generate')
-  (run-hooks
-   (if (prog1
-	   (zerop (mod ps-page-count ps-number-of-columns))
-	 (setq ps-page-count (1+ ps-page-count)))
-       (prog1
-	   (if (zerop (mod ps-page-postscript ps-n-up-printing))
-	       ;; Print only when a new sheet begins.
-	       (progn
-		 (ps-header-sheet)
-		 'ps-print-begin-sheet-hook)
-	     ;; Print only when a new page begins.
-	     (setq ps-page-postscript (1+ ps-page-postscript))
-	     (ps-output "BeginDSCPage\n")
-	     'ps-print-begin-page-hook)
-	 (ps-background ps-page-postscript))
-     ;; Print only when a new column begins.
-     (ps-output "BeginDSCPage\n")
-     'ps-print-begin-column-hook)))
+  (if (zerop (mod ps-page-count ps-number-of-columns))
+      (progn
+	(setq ps-page-postscript (1+ ps-page-postscript))
+	(when (ps-print-page-p)
+	  (if (zerop (mod ps-page-n-up ps-n-up-printing))
+	      ;; Print only when a new sheet begins.
+	      (progn
+		(ps-header-sheet)
+		(run-hooks 'ps-print-begin-sheet-hook))
+	    ;; Print only when a new page begins.
+	    (ps-output "BeginDSCPage\n")
+	    (run-hooks 'ps-print-begin-page-hook))
+	  (ps-background ps-page-postscript)
+	  (setq ps-page-n-up (1+ ps-page-n-up))))
+    ;; Print only when a new column begins.
+    (ps-output "BeginDSCPage\n")
+    (run-hooks 'ps-print-begin-column-hook))
+  (setq ps-page-count (1+ ps-page-count)))
 
 (defun ps-begin-page ()
   (ps-get-page-dimensions)
@@ -4821,9 +4823,7 @@
   (ps-header-page)
 
   (ps-output (format "/LineNumber %d def\n" ps-showline-count)
-	     (format "/PageNumber %d def\n" (if ps-print-only-one-header
-						(ps-page-number)
-					      ps-page-count)))
+	     (format "/PageNumber %d def\n" (ps-page-number)))
 
   (when ps-print-header
     (ps-generate-header "HeaderLinesLeft"    ps-left-header)
@@ -4839,17 +4839,6 @@
 (defun ps-end-page ()
   (ps-output "EndPage\nEndDSCPage\n"))
 
-(defun ps-dummy-page ()
-  (let ((ps-n-up-printing 0))
-    (ps-header-sheet))
-  (ps-output "/PrintHeader false def
-/ColumnIndex 0 def
-/PrintLineNumber false def
-BeginPage
-EndPage
-EndDSCPage\n")
-  (setq ps-page-postscript ps-n-up-printing))
-
 (defun ps-next-line ()
   (setq ps-showline-count (1+ ps-showline-count))
   (let ((lh (ps-line-height 'ps-font-for-text)))
@@ -4969,7 +4958,7 @@
       (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))
+		 (match       (char-after match-point))
 		 (composition (ps-e-find-composition from (1+ match-point))))
 	    (if composition
 		(if (and (nth 2 composition)
@@ -5215,12 +5204,14 @@
 
 
 ;; to avoid compilation gripes
-(eval-and-compile
-  (require 'lazy-lock)
-
-  (defun ps-print-ensure-fontified (start end)
-    (and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode)
-	 (lazy-lock-fontify-region start end))))
+(defun ps-print-ensure-fontified (start end)
+  (cond
+   ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
+    (defalias 'ps-jitify 'jit-lock-fontify-now) ; avoid compilation gripes
+    (ps-jitify start end))
+   ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
+    (defalias 'ps-lazify 'lazy-lock-fontify-region) ; avoid compilation gripes
+    (ps-lazify start end))))
 
 
 (defun ps-generate-postscript-with-faces (from to)
@@ -5263,9 +5254,8 @@
 	    ;; 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.
+	    ;; 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))
 
@@ -5372,22 +5362,21 @@
 		(goto-char (point-min))
 		(or (looking-at (regexp-quote ps-adobe-tag))
 		    (setq needs-begin-file t))
+
+		(set-buffer ps-source-buffer)
 		(save-excursion
-		  (set-buffer ps-source-buffer)
-		  (let (ps-even-or-odd-pages)
+		  (let ((ps-print-page-p t)
+			ps-even-or-odd-pages)
 		    (ps-begin-job)
 		    (when needs-begin-file
 		      (ps-begin-file)
 		      (ps-mule-initialize))
 		    (ps-mule-begin-job from to)
-		    (ps-selected-pages))
-		  (ps-begin-page))
-		(set-buffer ps-source-buffer)
+		    (ps-selected-pages)))
+		(ps-begin-page)
 		(funcall genfunc from to)
 		(ps-end-page)
-
-		(ps-end-file needs-begin-file)
-		(ps-end-job)
+		(ps-end-job needs-begin-file)
 
 		;; Setting this variable tells the unwind form that the
 		;; the PostScript was generated without error.
@@ -5405,20 +5394,42 @@
 	(and ps-razzle-dazzle (message "Formatting...done"))))))
 
 
-(defun ps-end-job ()
-  (ps-flush-output)
-  (let ((total-lines (cdr ps-printing-region))
-	(total-pages (if ps-print-only-one-header
-			 (ps-page-number)
-		       ps-page-count))
-	case-fold-search)
-    (set-buffer ps-spool-buffer)
-    ;; Back to the PS output buffer to set the page count
-    (goto-char (point-min))
-    (and (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)))
-  ;; selected pages
+(defun ps-end-job (needs-begin-file)
+  (let ((ps-print-page-p t))
+    (ps-flush-output)
+    (save-excursion
+      (let ((pages-per-sheet (mod ps-page-n-up ps-n-up-printing))
+	    (total-lines (cdr ps-printing-region))
+	    (total-pages (ps-page-number))
+	    case-fold-search)
+	(set-buffer ps-spool-buffer)
+	;; Back to the PS output buffer to set the last page n-up printing
+	(goto-char (point-max))
+	(and (> pages-per-sheet 0)
+	     (re-search-backward "^[0-9]+ BeginSheet$" nil t)
+	     (replace-match (format "%d BeginSheet" pages-per-sheet) t))
+	;; Back to the PS output buffer to set the page count
+	(goto-char (point-min))
+	(and (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))))
+    ;; Set dummy page
+    (and ps-spool-duplex (= (mod ps-page-order 2) 1)
+	 (let ((ps-n-up-printing 0))
+	   (ps-header-sheet)
+	   (ps-output "/PrintHeader false def\n/ColumnIndex 0 def\n"
+		      "/PrintLineNumber false def\nBeginPage\n")
+	   (ps-end-page)))
+    ;; Set end of PostScript file
+    (ps-output "EndSheet\n\n%%Trailer\n%%Pages: "
+	       (number-to-string
+		(if (and needs-begin-file
+			 ps-banner-page-when-duplexing)
+		    (1+ ps-page-order)
+		  ps-page-order))
+	       "\n\nEndDoc\n\n%%EOF\n")
+    (ps-flush-output))
+  ;; disable selected pages
   (setq ps-selected-pages nil))