X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/984e7bd979a0f4bdffa4c780ba0cc4ebb9d34beb..3e56710f649d8c4c198c92e8047f60687e30ad23:/lisp/ps-print.el diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 6c037b1275..6f18fd6857 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -7,11 +7,11 @@ ;; Author: Vinicius Jose Latorre ;; Maintainer: Vinicius Jose Latorre ;; Keywords: print, PostScript -;; Time-stamp: <98/05/15 21:15:06 vinicius> -;; Version: 3.06.1 +;; Time-stamp: <98/06/04 15:23:12 vinicius> +;; Version: 3.06.3 -(defconst ps-print-version "3.06.1" - "ps-print.el, v 3.06.1 <98/05/15 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, @@ -923,6 +923,30 @@ Please send all bug fixes and enhancements to :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 @@ -1018,7 +1042,7 @@ Valid values are: 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) @@ -2065,19 +2089,23 @@ StandardEncoding 46 82 getinterval aload pop % 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: -- @@ -2394,6 +2422,7 @@ StandardEncoding 46 82 getinterval aload pop (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) @@ -3199,7 +3228,7 @@ page-height == bm + print-height + tm - ho - hh (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 @@ -3259,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 (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) @@ -3325,7 +3347,13 @@ page-height == bm + print-height + tm - ho - hh (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]") @@ -3340,7 +3368,7 @@ page-height == bm + print-height + tm - ho - hh (defun ps-end-file () (ps-output "\n%%Trailer\n%%Pages: " - (format "%d" (ps-page-number)) + (format "%d" ps-page-postscript) "\n\nEndDoc\n\n%%EOF\n")) @@ -3350,17 +3378,21 @@ page-height == bm + print-height + tm - ho - hh (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)) (setq ps-page-count (1+ ps-page-count))) ;; 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. - (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 () @@ -3903,7 +3935,7 @@ If FACE is not a valid face name, it is used default face." (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. @@ -3924,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)) + (ps-end-file) (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. @@ -3956,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") - (ps-end-file) - (ps-flush-output) (if filename (save-excursion (and ps-razzle-dazzle (message "Saving...")) @@ -3970,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) - (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) - (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)