aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/ChangeLog21
-rw-r--r--lisp/ps-print.el421
2 files changed, 237 insertions, 205 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9edee672e18..32ed0642210 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,24 @@
12000-10-31 Vinicius Jose Latorre <vinicius@cpqd.com.br>
2
3 * ps-print.el: Fix bug on selected pages for printing. Use
4 `color-values' for Emacs 21. Ensure fontification when jit-lock
5 is on. Try to avoid warning messages when compiling. Doc Fix.
6 (ps-print-version): New version number (6.3).
7 (ps-color-device): Use `color-values' to determine if device
8 supports color.
9 (ps-color-values): Try to use `x-color-values' when using XEmacs.
10 (ps-print-page-p): Changed from defsubst to defun.
11 (ps-page-number): Changed from defmacro to defun.
12 (ps-header-sheet, ps-header-page): Fix bug on selected pages for
13 printing.
14 (ps-print-ensure-fontified): Ensure fontification when jit-lock is
15 on.
16 (ps-end-file, ps-dummy-page): Funs eliminated.
17 (ps-print-color-scale): Changed default value.
18 (ps-page-n-up, ps-print-page-p): New internal vars.
19 (ps-print-preprint, ps-output, ps-begin-file, ps-begin-page)
20 (ps-plot-region, ps-generate, ps-end-job): Code fix.
21
12000-10-31 Kenichi Handa <handa@etl.go.jp> 222000-10-31 Kenichi Handa <handa@etl.go.jp>
2 23
3 * term/mac-win.el: (decode-mac-roman, encode-mac-roman, 24 * term/mac-win.el: (decode-mac-roman, encode-mac-roman,
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 57353f9890c..8d46574755f 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -9,12 +9,12 @@
9;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) 9;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
10;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> 10;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
11;; Keywords: wp, print, PostScript 11;; Keywords: wp, print, PostScript
12;; Time-stamp: <2000/10/19 11:54:10 vinicius> 12;; Time-stamp: <2000/10/28 23:38:44 Vinicius>
13;; Version: 6.2.1 13;; Version: 6.3
14;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ 14;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
15 15
16(defconst ps-print-version "6.2.1" 16(defconst ps-print-version "6.3"
17 "ps-print.el, v 6.2.1 <2000/10/19 vinicius> 17 "ps-print.el, v 6.3 <2000/10/28 vinicius>
18 18
19Vinicius's last change version -- this file may have been edited as part of 19Vinicius's last change version -- this file may have been edited as part of
20Emacs without changes to the version number. When reporting bugs, please also 20Emacs without changes to the version number. When reporting bugs, please also
@@ -1301,68 +1301,71 @@ Please send all bug fixes and enhancements to
1301 1301
1302;;; Code: 1302;;; Code:
1303 1303
1304(unless (featurep 'lisp-float-type) 1304(eval-and-compile
1305 (error "`ps-print' requires floating point support")) 1305 (unless (featurep 'lisp-float-type)
1306 1306 (error "`ps-print' requires floating point support"))
1307
1308;; For Emacs 20.2 and the earlier version.
1309 1307
1310(or (fboundp 'set-buffer-multibyte)
1311 (defun set-buffer-multibyte (arg)
1312 (setq enable-multibyte-characters arg)))
1313 1308
1314(or (fboundp 'string-as-unibyte) 1309 ;; For Emacs 20.2 and the earlier version.
1315 (defun string-as-unibyte (arg) arg))
1316 1310
1317(or (fboundp 'string-as-multibyte) 1311 (or (fboundp 'set-buffer-multibyte)
1318 (defun string-as-multibyte (arg) arg)) 1312 (defun set-buffer-multibyte (arg)
1313 (setq enable-multibyte-characters arg)))
1319 1314
1320(or (fboundp 'char-charset) 1315 (or (fboundp 'string-as-unibyte)
1321 (defun char-charset (arg) 'ascii)) 1316 (defun string-as-unibyte (arg) arg))
1322 1317
1323(or (fboundp 'charset-after) 1318 (or (fboundp 'string-as-multibyte)
1324 (defun charset-after (&optional arg) 1319 (defun string-as-multibyte (arg) arg))
1325 (char-charset (char-after arg))))
1326 1320
1321 (or (fboundp 'char-charset)
1322 (defun char-charset (arg) 'ascii))
1327 1323
1328;; GNU Emacs 1324 (or (fboundp 'charset-after)
1329(or (fboundp 'line-beginning-position) 1325 (defun charset-after (&optional arg)
1330 (defun line-beginning-position (&optional n) 1326 (char-charset (char-after arg))))
1331 (save-excursion
1332 (and n (/= n 1) (forward-line (1- n)))
1333 (beginning-of-line)
1334 (point))))
1335 1327
1336 1328
1337;; to avoid compilation gripes 1329 ;; GNU Emacs
1338 1330 (or (fboundp 'line-beginning-position)
1339;; XEmacs 1331 (defun line-beginning-position (&optional n)
1340(defalias 'ps-x-color-instance-p 'color-instance-p) 1332 (save-excursion
1341(defalias 'ps-x-color-instance-rgb-components 'color-instance-rgb-components) 1333 (and n (/= n 1) (forward-line (1- n)))
1342(defalias 'ps-x-color-name 'color-name) 1334 (beginning-of-line)
1343(defalias 'ps-x-color-specifier-p 'color-specifier-p) 1335 (point))))
1344(defalias 'ps-x-copy-coding-system 'copy-coding-system) 1336
1345(defalias 'ps-x-device-class 'device-class) 1337
1346(defalias 'ps-x-extent-end-position 'extent-end-position) 1338 ;; to avoid compilation gripes
1347(defalias 'ps-x-extent-face 'extent-face) 1339
1348(defalias 'ps-x-extent-priority 'extent-priority) 1340 ;; XEmacs
1349(defalias 'ps-x-extent-start-position 'extent-start-position) 1341 (defalias 'ps-x-color-instance-p 'color-instance-p)
1350(defalias 'ps-x-face-font-instance 'face-font-instance) 1342 (defalias 'ps-x-color-instance-rgb-components 'color-instance-rgb-components)
1351(defalias 'ps-x-find-coding-system 'find-coding-system) 1343 (defalias 'ps-x-color-name 'color-name)
1352(defalias 'ps-x-font-instance-properties 'font-instance-properties) 1344 (defalias 'ps-x-color-specifier-p 'color-specifier-p)
1353(defalias 'ps-x-make-color-instance 'make-color-instance) 1345 (defalias 'ps-x-copy-coding-system 'copy-coding-system)
1354(defalias 'ps-x-map-extents 'map-extents) 1346 (defalias 'ps-x-device-class 'device-class)
1355 1347 (defalias 'ps-x-extent-end-position 'extent-end-position)
1356;; GNU Emacs 1348 (defalias 'ps-x-extent-face 'extent-face)
1357(if (fboundp 'find-composition) 1349 (defalias 'ps-x-extent-priority 'extent-priority)
1358 (defalias 'ps-e-find-composition 'find-composition) 1350 (defalias 'ps-x-extent-start-position 'extent-start-position)
1359 (defalias 'ps-e-find-composition 'ignore)) 1351 (defalias 'ps-x-face-font-instance 'face-font-instance)
1360 1352 (defalias 'ps-x-find-coding-system 'find-coding-system)
1361 1353 (defalias 'ps-x-font-instance-properties 'font-instance-properties)
1362(defconst ps-windows-system 1354 (defalias 'ps-x-make-color-instance 'make-color-instance)
1363 (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt))) 1355 (defalias 'ps-x-map-extents 'map-extents)
1364(defconst ps-lp-system 1356
1365 (memq system-type '(usq-unix-v dgux hpux irix))) 1357 ;; GNU Emacs
1358 (defalias 'ps-e-x-color-values 'x-color-values)
1359 (defalias 'ps-e-color-values 'color-values)
1360 (if (fboundp 'find-composition)
1361 (defalias 'ps-e-find-composition 'find-composition)
1362 (defalias 'ps-e-find-composition 'ignore))
1363
1364
1365 (defconst ps-windows-system
1366 (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
1367 (defconst ps-lp-system
1368 (memq system-type '(usq-unix-v dgux hpux irix))))
1366 1369
1367 1370
1368;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1371;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1722,7 +1725,9 @@ After ps-print processing `ps-selected-pages' is set to nil. But the latest
1722`ps-selected-pages' is saved in `ps-last-selected-pages' (see it for 1725`ps-selected-pages' is saved in `ps-last-selected-pages' (see it for
1723documentation). So you can restore the latest selected pages by using 1726documentation). So you can restore the latest selected pages by using
1724`ps-last-selected-pages' or by calling `ps-restore-selected-pages' command (see 1727`ps-last-selected-pages' or by calling `ps-restore-selected-pages' command (see
1725it for documentation)." 1728it for documentation).
1729
1730See also `ps-even-or-odd-pages'."
1726 :type '(repeat :tag "Selected Pages" 1731 :type '(repeat :tag "Selected Pages"
1727 (radio :tag "Page" 1732 (radio :tag "Page"
1728 (integer :tag "Number") 1733 (integer :tag "Number")
@@ -1742,7 +1747,20 @@ Valid values are:
1742 1747
1743 `odd' print only odd pages. 1748 `odd' print only odd pages.
1744 1749
1745Any other value is treated as nil." 1750Any other value is treated as nil.
1751
1752If you set `ps-selected-pages' (see it for documentation), first the pages are
1753filtered by `ps-selected-pages' and then by `ps-even-or-odd-pages'. For
1754example, if we have:
1755
1756 (setq ps-selected-pages '(1 4 (6 . 10) 12))
1757
1758We have the following results:
1759
1760 `ps-even-or-odd-pages' PAGES PRINTED
1761 nil 1, 4, 6, 7, 8, 9, 10, 12
1762 even 4, 6, 8, 10, 12
1763 odd 1, 7, 9"
1746 :type '(choice :menu-tag "Print Even/Odd Pages" 1764 :type '(choice :menu-tag "Print Even/Odd Pages"
1747 :tag "Print Even/Odd Pages" 1765 :tag "Print Even/Odd Pages"
1748 (const :tag "All Pages" nil) 1766 (const :tag "All Pages" nil)
@@ -2415,8 +2433,11 @@ it uses the fonts resident in your printer."
2415;;; Colors 2433;;; Colors
2416 2434
2417;; Printing color requires x-color-values. 2435;; Printing color requires x-color-values.
2418(defcustom ps-print-color-p (or (fboundp 'x-color-values) ; Emacs 2436(defcustom ps-print-color-p
2419 (fboundp 'color-instance-rgb-components)) 2437 (or (and (fboundp 'color-values) ; Emacs
2438 (ps-e-color-values "Green"))
2439 (fboundp 'x-color-values) ; Emacs
2440 (fboundp 'color-instance-rgb-components))
2420 ; XEmacs 2441 ; XEmacs
2421 "*Non-nil means print the buffer's text in color." 2442 "*Non-nil means print the buffer's text in color."
2422 :type 'boolean 2443 :type 'boolean
@@ -2911,17 +2932,18 @@ The table depends on the current ps-print setup."
2911 2932
2912 ;; Return t if the device (which can be changed during an emacs session) 2933 ;; Return t if the device (which can be changed during an emacs session)
2913 ;; can handle colors. 2934 ;; can handle colors.
2914 ;; This is function is not yet implemented for GNU emacs. 2935 ;; This function is not yet implemented for GNU emacs.
2915 (cond ((and (eq ps-print-emacs-type 'xemacs) 2936 (cond ((and (eq ps-print-emacs-type 'xemacs)
2916 (>= emacs-minor-version 12)) ; xemacs 2937 (>= emacs-minor-version 12)) ; xemacs
2917 (defun ps-color-device () 2938 (defun ps-color-device ()
2918 (eq (ps-x-device-class) 'color)) 2939 (eq (ps-x-device-class) 'color)))
2919 )
2920 2940
2921 (t ; emacs 2941 (t ; emacs
2922 (defun ps-color-device () 2942 (defun ps-color-device ()
2923 t) 2943 (if (fboundp 'color-values)
2924 )) 2944 (ps-e-color-values "Green")
2945 t))))
2946
2925 2947
2926 (defun ps-mapper (extent list) 2948 (defun ps-mapper (extent list)
2927 (nconc list 2949 (nconc list
@@ -2951,9 +2973,13 @@ The table depends on the current ps-print setup."
2951 (cond ((eq ps-print-emacs-type 'emacs) ; emacs 2973 (cond ((eq ps-print-emacs-type 'emacs) ; emacs
2952 2974
2953 (defun ps-color-values (x-color) 2975 (defun ps-color-values (x-color)
2954 (if (fboundp 'x-color-values) 2976 (cond
2955 (x-color-values x-color) 2977 ((fboundp 'color-values)
2956 (error "No available function to determine X color values."))) 2978 (ps-e-color-values x-color))
2979 ((fboundp 'x-color-values)
2980 (ps-e-x-color-values x-color))
2981 (t
2982 (error "No available function to determine X color values."))))
2957 2983
2958 (defalias 'ps-face-foreground-name 'face-foreground) 2984 (defalias 'ps-face-foreground-name 'face-foreground)
2959 (defalias 'ps-face-background-name 'face-background) 2985 (defalias 'ps-face-background-name 'face-background)
@@ -2977,7 +3003,7 @@ The table depends on the current ps-print setup."
2977 (let ((color (ps-xemacs-color-name x-color))) 3003 (let ((color (ps-xemacs-color-name x-color)))
2978 (cond 3004 (cond
2979 ((fboundp 'x-color-values) 3005 ((fboundp 'x-color-values)
2980 (x-color-values color)) 3006 (ps-e-x-color-values color))
2981 ((and (fboundp 'color-instance-rgb-components) 3007 ((and (fboundp 'color-instance-rgb-components)
2982 (ps-color-device)) 3008 (ps-color-device))
2983 (ps-x-color-instance-rgb-components 3009 (ps-x-color-instance-rgb-components
@@ -3004,7 +3030,7 @@ The table depends on the current ps-print setup."
3004 ))) 3030 )))
3005 3031
3006 3032
3007(defvar ps-print-color-scale nil) 3033(defvar ps-print-color-scale 1.0)
3008 3034
3009(defun ps-color-scale (color) 3035(defun ps-color-scale (color)
3010 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval. 3036 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
@@ -3057,9 +3083,11 @@ The table depends on the current ps-print setup."
3057(defvar ps-page-postscript 0) 3083(defvar ps-page-postscript 0)
3058(defvar ps-page-order 0) 3084(defvar ps-page-order 0)
3059(defvar ps-page-count 0) 3085(defvar ps-page-count 0)
3086(defvar ps-page-n-up 0)
3060(defvar ps-showline-count 1) 3087(defvar ps-showline-count 1)
3061(defvar ps-first-page nil) 3088(defvar ps-first-page nil)
3062(defvar ps-last-page nil) 3089(defvar ps-last-page nil)
3090(defvar ps-print-page-p t)
3063 3091
3064(defvar ps-control-or-escape-regexp nil) 3092(defvar ps-control-or-escape-regexp nil)
3065(defvar ps-n-up-on nil) 3093(defvar ps-n-up-on nil)
@@ -3614,16 +3642,19 @@ page-height == bm + print-height + tm - ho - hh
3614 ".ps")) 3642 ".ps"))
3615 (prompt (format "Save PostScript to file: (default %s) " name)) 3643 (prompt (format "Save PostScript to file: (default %s) " name))
3616 (res (read-file-name prompt default-directory name nil))) 3644 (res (read-file-name prompt default-directory name nil)))
3617 (while (cond ((not (file-writable-p res)) 3645 (while (cond ((file-directory-p res)
3646 (ding)
3647 (setq prompt "It's a directory"))
3648 ((not (file-writable-p res))
3618 (ding) 3649 (ding)
3619 (setq prompt "is unwritable")) 3650 (setq prompt "File is unwritable"))
3620 ((file-exists-p res) 3651 ((file-exists-p res)
3621 (setq prompt "exists") 3652 (setq prompt "File exists")
3622 (not (y-or-n-p (format "File `%s' exists; overwrite? " 3653 (not (y-or-n-p (format "File `%s' exists; overwrite? "
3623 res)))) 3654 res))))
3624 (t nil)) 3655 (t nil))
3625 (setq res (read-file-name 3656 (setq res (read-file-name
3626 (format "File %s; save PostScript to file: " prompt) 3657 (format "%s; save PostScript to file: " prompt)
3627 (file-name-directory res) nil nil 3658 (file-name-directory res) nil nil
3628 (file-name-nondirectory res)))) 3659 (file-name-nondirectory res))))
3629 (if (file-directory-p res) 3660 (if (file-directory-p res)
@@ -3691,26 +3722,27 @@ page-height == bm + print-height + tm - ho - hh
3691 (< ps-last-page ps-page-postscript))))) 3722 (< ps-last-page ps-page-postscript)))))
3692 3723
3693 3724
3694(defsubst ps-print-page-p () 3725(defun ps-print-page-p ()
3695 (and (cond ((null ps-first-page)) 3726 (setq ps-print-page-p
3696 ((<= ps-page-postscript ps-last-page) 3727 (and (cond ((null ps-first-page))
3697 (<= ps-first-page ps-page-postscript)) 3728 ((<= ps-page-postscript ps-last-page)
3698 (ps-selected-pages 3729 (<= ps-first-page ps-page-postscript))
3699 (ps-selected-pages) 3730 (ps-selected-pages
3700 (and (<= ps-first-page ps-page-postscript) 3731 (ps-selected-pages)
3701 (<= ps-page-postscript ps-last-page))) 3732 (and (<= ps-first-page ps-page-postscript)
3702 (t 3733 (<= ps-page-postscript ps-last-page)))
3703 nil)) 3734 (t
3704 (cond ((eq ps-even-or-odd-pages 'even) 3735 nil))
3705 (= (logand ps-page-postscript 1) 0)) 3736 (cond ((eq ps-even-or-odd-pages 'even)
3706 ((eq ps-even-or-odd-pages 'odd) 3737 (= (logand ps-page-postscript 1) 0))
3707 (= (logand ps-page-postscript 1) 1)) 3738 ((eq ps-even-or-odd-pages 'odd)
3708 (t) 3739 (= (logand ps-page-postscript 1) 1))
3709 ))) 3740 (t)
3741 ))))
3710 3742
3711 3743
3712(defun ps-output (&rest args) 3744(defun ps-output (&rest args)
3713 (when (ps-print-page-p) 3745 (when ps-print-page-p
3714 (setcdr ps-output-tail args) 3746 (setcdr ps-output-tail args)
3715 (while (cdr ps-output-tail) 3747 (while (cdr ps-output-tail)
3716 (setq ps-output-tail (cdr ps-output-tail))))) 3748 (setq ps-output-tail (cdr ps-output-tail)))))
@@ -4388,6 +4420,8 @@ XSTART YSTART are the relative position for the first page in a sheet.")
4388 (ps-get-page-dimensions) 4420 (ps-get-page-dimensions)
4389 (setq ps-page-postscript 0 4421 (setq ps-page-postscript 0
4390 ps-page-order 0 4422 ps-page-order 0
4423 ps-page-n-up 0
4424 ps-print-page-p t
4391 ps-background-text-count 0 4425 ps-background-text-count 0
4392 ps-background-image-count 0 4426 ps-background-image-count 0
4393 ps-background-pages nil 4427 ps-background-pages nil
@@ -4733,36 +4767,10 @@ XSTART YSTART are the relative position for the first page in a sheet.")
4733 )) 4767 ))
4734 4768
4735 4769
4736(defmacro ps-page-number () 4770(defun ps-page-number ()
4737 `(1+ (/ (1- ps-page-count) ps-number-of-columns))) 4771 (if ps-print-only-one-header
4738 4772 (1+ (/ (1- ps-page-count) ps-number-of-columns))
4739(defun ps-end-file (needs-begin-file) 4773 ps-page-count))
4740 (let (ps-even-or-odd-pages)
4741 (ps-flush-output)
4742 ;; Back to the PS output buffer to set the last page n-up printing
4743 (save-excursion
4744 (let ((pages-per-sheet (mod ps-page-postscript ps-n-up-printing))
4745 case-fold-search)
4746 (set-buffer ps-spool-buffer)
4747 (goto-char (point-max))
4748 (and (> pages-per-sheet 0)
4749 (re-search-backward "^[0-9]+ BeginSheet$" nil t)
4750 (replace-match (format "%d BeginSheet" pages-per-sheet) t))))
4751 ;; Set dummy page
4752 (and ps-spool-duplex (= (mod ps-page-order 2) 1)
4753 (let (ps-first-page)
4754 (ps-dummy-page)))
4755 ;; Set end of PostScript file
4756 (or ps-first-page
4757 (ps-output "EndSheet\n"))
4758 (setq ps-first-page nil) ; disable selected pages
4759 (ps-output "\n%%Trailer\n%%Pages: "
4760 (format "%d"
4761 (if (and needs-begin-file
4762 ps-banner-page-when-duplexing)
4763 (1+ ps-page-order)
4764 ps-page-order))
4765 "\n\nEndDoc\n\n%%EOF\n")))
4766 4774
4767 4775
4768(defun ps-next-page () 4776(defun ps-next-page ()
@@ -4773,45 +4781,39 @@ XSTART YSTART are the relative position for the first page in a sheet.")
4773 4781
4774(defun ps-header-sheet () 4782(defun ps-header-sheet ()
4775 ;; Print only when a new sheet begins. 4783 ;; Print only when a new sheet begins.
4776 (let ((print-posterior (ps-print-page-p))) 4784 (setq ps-page-order (1+ ps-page-order))
4777 (setq ps-page-postscript (1+ ps-page-postscript)) 4785 (and (> ps-page-order 1)
4778 (cond ((ps-print-page-p) 4786 (ps-output "EndSheet\n"))
4779 (setq ps-page-order (1+ ps-page-order)) 4787 (ps-output (if ps-n-up-on
4780 (and (or print-posterior ps-even-or-odd-pages) (> ps-page-order 1) 4788 (format "\n%%%%Page: (%d \\(%d\\)) %d\n"
4781 (ps-output "EndSheet\n")) 4789 ps-page-order ps-page-postscript ps-page-order)
4782 (ps-output (if ps-n-up-on 4790 (format "\n%%%%Page: %d %d\n"
4783 (format "\n%%%%Page: (%d \\(%d\\)) %d\n" 4791 ps-page-postscript ps-page-order))
4784 ps-page-order ps-page-postscript ps-page-order) 4792 (format "%d BeginSheet\nBeginDSCPage\n"
4785 (format "\n%%%%Page: %d %d\n" 4793 ps-n-up-printing)))
4786 ps-page-postscript ps-page-order)) 4794
4787 (format "%d BeginSheet\nBeginDSCPage\n" 4795
4788 ps-n-up-printing))) 4796(defun ps-header-page ()
4789 (print-posterior
4790 (let (ps-first-page)
4791 (ps-output "EndSheet\n"))))))
4792
4793
4794(defsubst ps-header-page ()
4795 ;; set total line and page number when printing has finished 4797 ;; set total line and page number when printing has finished
4796 ;; (see `ps-generate') 4798 ;; (see `ps-generate')
4797 (run-hooks 4799 (if (zerop (mod ps-page-count ps-number-of-columns))
4798 (if (prog1 4800 (progn
4799 (zerop (mod ps-page-count ps-number-of-columns)) 4801 (setq ps-page-postscript (1+ ps-page-postscript))
4800 (setq ps-page-count (1+ ps-page-count))) 4802 (when (ps-print-page-p)
4801 (prog1 4803 (if (zerop (mod ps-page-n-up ps-n-up-printing))
4802 (if (zerop (mod ps-page-postscript ps-n-up-printing)) 4804 ;; Print only when a new sheet begins.
4803 ;; Print only when a new sheet begins. 4805 (progn
4804 (progn 4806 (ps-header-sheet)
4805 (ps-header-sheet) 4807 (run-hooks 'ps-print-begin-sheet-hook))
4806 'ps-print-begin-sheet-hook) 4808 ;; Print only when a new page begins.
4807 ;; Print only when a new page begins. 4809 (ps-output "BeginDSCPage\n")
4808 (setq ps-page-postscript (1+ ps-page-postscript)) 4810 (run-hooks 'ps-print-begin-page-hook))
4809 (ps-output "BeginDSCPage\n") 4811 (ps-background ps-page-postscript)
4810 'ps-print-begin-page-hook) 4812 (setq ps-page-n-up (1+ ps-page-n-up))))
4811 (ps-background ps-page-postscript)) 4813 ;; Print only when a new column begins.
4812 ;; Print only when a new column begins. 4814 (ps-output "BeginDSCPage\n")
4813 (ps-output "BeginDSCPage\n") 4815 (run-hooks 'ps-print-begin-column-hook))
4814 'ps-print-begin-column-hook))) 4816 (setq ps-page-count (1+ ps-page-count)))
4815 4817
4816(defun ps-begin-page () 4818(defun ps-begin-page ()
4817 (ps-get-page-dimensions) 4819 (ps-get-page-dimensions)
@@ -4821,9 +4823,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
4821 (ps-header-page) 4823 (ps-header-page)
4822 4824
4823 (ps-output (format "/LineNumber %d def\n" ps-showline-count) 4825 (ps-output (format "/LineNumber %d def\n" ps-showline-count)
4824 (format "/PageNumber %d def\n" (if ps-print-only-one-header 4826 (format "/PageNumber %d def\n" (ps-page-number)))
4825 (ps-page-number)
4826 ps-page-count)))
4827 4827
4828 (when ps-print-header 4828 (when ps-print-header
4829 (ps-generate-header "HeaderLinesLeft" ps-left-header) 4829 (ps-generate-header "HeaderLinesLeft" ps-left-header)
@@ -4839,17 +4839,6 @@ XSTART YSTART are the relative position for the first page in a sheet.")
4839(defun ps-end-page () 4839(defun ps-end-page ()
4840 (ps-output "EndPage\nEndDSCPage\n")) 4840 (ps-output "EndPage\nEndDSCPage\n"))
4841 4841
4842(defun ps-dummy-page ()
4843 (let ((ps-n-up-printing 0))
4844 (ps-header-sheet))
4845 (ps-output "/PrintHeader false def
4846/ColumnIndex 0 def
4847/PrintLineNumber false def
4848BeginPage
4849EndPage
4850EndDSCPage\n")
4851 (setq ps-page-postscript ps-n-up-printing))
4852
4853(defun ps-next-line () 4842(defun ps-next-line ()
4854 (setq ps-showline-count (1+ ps-showline-count)) 4843 (setq ps-showline-count (1+ ps-showline-count))
4855 (let ((lh (ps-line-height 'ps-font-for-text))) 4844 (let ((lh (ps-line-height 'ps-font-for-text)))
@@ -4969,7 +4958,7 @@ EndDSCPage\n")
4969 (if (re-search-forward ps-control-or-escape-regexp to t) 4958 (if (re-search-forward ps-control-or-escape-regexp to t)
4970 ;; region with some control characters or some multi-byte characters 4959 ;; region with some control characters or some multi-byte characters
4971 (let* ((match-point (match-beginning 0)) 4960 (let* ((match-point (match-beginning 0))
4972 (match (char-after match-point)) 4961 (match (char-after match-point))
4973 (composition (ps-e-find-composition from (1+ match-point)))) 4962 (composition (ps-e-find-composition from (1+ match-point))))
4974 (if composition 4963 (if composition
4975 (if (and (nth 2 composition) 4964 (if (and (nth 2 composition)
@@ -5215,12 +5204,14 @@ If FACE is not a valid face name, it is used default face."
5215 5204
5216 5205
5217;; to avoid compilation gripes 5206;; to avoid compilation gripes
5218(eval-and-compile 5207(defun ps-print-ensure-fontified (start end)
5219 (require 'lazy-lock) 5208 (cond
5220 5209 ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
5221 (defun ps-print-ensure-fontified (start end) 5210 (defalias 'ps-jitify 'jit-lock-fontify-now) ; avoid compilation gripes
5222 (and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode) 5211 (ps-jitify start end))
5223 (lazy-lock-fontify-region start end)))) 5212 ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
5213 (defalias 'ps-lazify 'lazy-lock-fontify-region) ; avoid compilation gripes
5214 (ps-lazify start end))))
5224 5215
5225 5216
5226(defun ps-generate-postscript-with-faces (from to) 5217(defun ps-generate-postscript-with-faces (from to)
@@ -5263,9 +5254,8 @@ If FACE is not a valid face name, it is used default face."
5263 ;; XEmacs 19.12: for some reason, we're getting into a 5254 ;; XEmacs 19.12: for some reason, we're getting into a
5264 ;; situation in which some of the records have 5255 ;; situation in which some of the records have
5265 ;; positions less than 'from'. Since we've narrowed 5256 ;; positions less than 'from'. Since we've narrowed
5266 ;; the buffer, this'll generate errors. This is a 5257 ;; the buffer, this'll generate errors. This is a hack,
5267 ;; hack, but don't call ps-plot-with-face unless from > 5258 ;; but don't call ps-plot-with-face unless from > point-min.
5268 ;; point-min.
5269 (and (>= from (point-min)) 5259 (and (>= from (point-min))
5270 (ps-plot-with-face from (min position (point-max)) face)) 5260 (ps-plot-with-face from (min position (point-max)) face))
5271 5261
@@ -5372,22 +5362,21 @@ If FACE is not a valid face name, it is used default face."
5372 (goto-char (point-min)) 5362 (goto-char (point-min))
5373 (or (looking-at (regexp-quote ps-adobe-tag)) 5363 (or (looking-at (regexp-quote ps-adobe-tag))
5374 (setq needs-begin-file t)) 5364 (setq needs-begin-file t))
5365
5366 (set-buffer ps-source-buffer)
5375 (save-excursion 5367 (save-excursion
5376 (set-buffer ps-source-buffer) 5368 (let ((ps-print-page-p t)
5377 (let (ps-even-or-odd-pages) 5369 ps-even-or-odd-pages)
5378 (ps-begin-job) 5370 (ps-begin-job)
5379 (when needs-begin-file 5371 (when needs-begin-file
5380 (ps-begin-file) 5372 (ps-begin-file)
5381 (ps-mule-initialize)) 5373 (ps-mule-initialize))
5382 (ps-mule-begin-job from to) 5374 (ps-mule-begin-job from to)
5383 (ps-selected-pages)) 5375 (ps-selected-pages)))
5384 (ps-begin-page)) 5376 (ps-begin-page)
5385 (set-buffer ps-source-buffer)
5386 (funcall genfunc from to) 5377 (funcall genfunc from to)
5387 (ps-end-page) 5378 (ps-end-page)
5388 5379 (ps-end-job needs-begin-file)
5389 (ps-end-file needs-begin-file)
5390 (ps-end-job)
5391 5380
5392 ;; Setting this variable tells the unwind form that the 5381 ;; Setting this variable tells the unwind form that the
5393 ;; the PostScript was generated without error. 5382 ;; the PostScript was generated without error.
@@ -5405,20 +5394,42 @@ If FACE is not a valid face name, it is used default face."
5405 (and ps-razzle-dazzle (message "Formatting...done")))))) 5394 (and ps-razzle-dazzle (message "Formatting...done"))))))
5406 5395
5407 5396
5408(defun ps-end-job () 5397(defun ps-end-job (needs-begin-file)
5409 (ps-flush-output) 5398 (let ((ps-print-page-p t))
5410 (let ((total-lines (cdr ps-printing-region)) 5399 (ps-flush-output)
5411 (total-pages (if ps-print-only-one-header 5400 (save-excursion
5412 (ps-page-number) 5401 (let ((pages-per-sheet (mod ps-page-n-up ps-n-up-printing))
5413 ps-page-count)) 5402 (total-lines (cdr ps-printing-region))
5414 case-fold-search) 5403 (total-pages (ps-page-number))
5415 (set-buffer ps-spool-buffer) 5404 case-fold-search)
5416 ;; Back to the PS output buffer to set the page count 5405 (set-buffer ps-spool-buffer)
5417 (goto-char (point-min)) 5406 ;; Back to the PS output buffer to set the last page n-up printing
5418 (and (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t) 5407 (goto-char (point-max))
5419 (replace-match (format "/Lines %d def\n/PageCount %d def" 5408 (and (> pages-per-sheet 0)
5420 total-lines total-pages) t))) 5409 (re-search-backward "^[0-9]+ BeginSheet$" nil t)
5421 ;; selected pages 5410 (replace-match (format "%d BeginSheet" pages-per-sheet) t))
5411 ;; Back to the PS output buffer to set the page count
5412 (goto-char (point-min))
5413 (and (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t)
5414 (replace-match (format "/Lines %d def\n/PageCount %d def"
5415 total-lines total-pages) t))))
5416 ;; Set dummy page
5417 (and ps-spool-duplex (= (mod ps-page-order 2) 1)
5418 (let ((ps-n-up-printing 0))
5419 (ps-header-sheet)
5420 (ps-output "/PrintHeader false def\n/ColumnIndex 0 def\n"
5421 "/PrintLineNumber false def\nBeginPage\n")
5422 (ps-end-page)))
5423 ;; Set end of PostScript file
5424 (ps-output "EndSheet\n\n%%Trailer\n%%Pages: "
5425 (number-to-string
5426 (if (and needs-begin-file
5427 ps-banner-page-when-duplexing)
5428 (1+ ps-page-order)
5429 ps-page-order))
5430 "\n\nEndDoc\n\n%%EOF\n")
5431 (ps-flush-output))
5432 ;; disable selected pages
5422 (setq ps-selected-pages nil)) 5433 (setq ps-selected-pages nil))
5423 5434
5424 5435