;;; ps-print.el --- Print text from the buffer as PostScript
-;; Copyright (C) 1993-2000 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2000 Free Software Foundation, Inc.
;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
;; Author: Jacques Duthen (was <duthen@cegelec-red.fr>)
;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
;; Keywords: wp, print, PostScript
-;; Time-stamp: <2000/07/28 21:47:57 vinicius>
-;; Version: 5.2.4
+;; 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 "5.2.4"
- "ps-print.el, v 5.2.4 <2000/07/28 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
;; The variable `ps-printer-name' determines the name of a local printer for
;; printing PostScript files.
;;
+;; The variable `ps-printer-name-option' determines the option used by some
+;; utilities to indicate the printer name, it's used only when
+;; `ps-printer-name' is a non-empty string. If you're using lpr utility to
+;; print, for example, `ps-printer-name-option' should be set to "-P".
+;;
;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values
;; from the variables `lpr-command' and `lpr-switches'. If you have
;; `lpr-command' set to invoke a pretty-printer such as `enscript',
;; then ps-print won't work properly. `ps-lpr-command' must name
;; a program that does not format the files it prints.
;; `ps-printer-name' takes its initial value from the variable
-;; `printer-name'.
+;; `printer-name'. `ps-printer-name-option' tries to guess which system
+;; Emacs is running and takes its initial value in accordance with this
+;; guess.
;;
;; The variable `ps-print-region-function' specifies a function to print the
;; region on a PostScript printer.
;; feeding takes place. The default is nil (automatic feeding).
;;
;; If you're using Emacs for Windows 95/98/NT or MS-DOS, don't forget to
-;; customize the following variables: `ps-printer-name', `ps-lpr-command',
-;; `ps-lpr-switches' and `ps-spool-config'. See these variables documentation
-;; in the code or by typing, for example, C-h v ps-printer-name RET.
+;; customize the following variables: `ps-printer-name',
+;; `ps-printer-name-option', `ps-lpr-command', `ps-lpr-switches' and
+;; `ps-spool-config'. See these variables documentation in the code or by
+;; typing, for example, C-h v ps-printer-name RET.
;;
;;
;; The Page Layout
;; latest selected pages by using `ps-last-selected-pages' or by calling
;; `ps-restore-selected-pages' command (see it for documentation).
;;
+;; The variable `ps-even-or-odd-pages' specifies if it prints even/odd pages.
+;;
+;; Valid values are:
+;;
+;; nil print all pages.
+;;
+;; even print only even pages.
+;;
+;; odd print only odd pages.
+;;
+;; Any other value is treated as nil. The default value is nil.
+;;
;;
;; Horizontal layout
;; -----------------
;;
;; By default `ps-user-defined-prologue' is nil.
;;
-;; It's recommended to initiate and terminate the string with "\n".
-;;
;; It's strongly recommended only insert PostScript code and/or comments
;; specific for your printing system particularities. For example, some special
;; initialization that only your printing system needs.
;; PostScript Language Reference Manual (2nd edition)
;; Adobe Systems Incorporated
;;
+;; As an example for `ps-user-defined-prologue' setting:
+;;
+;; ;; Setting for HP PostScript printer
+;; (setq ps-user-defined-prologue
+;; (concat "<</DeferredMediaSelection true /PageSize [612 792] "
+;; "/MediaPosition 2 /MediaType (Plain)>> setpagedevice"))
+;;
;;
;; PostScript Error Handler
;; ------------------------
;; of `ps-line-number-step' inclusive.
;;
;; * If `ps-line-number-step' is set to `zebra', must be between 1 and the
-;; value of `ps-zebra-strip-height' inclusive.
+;; value of `ps-zebra-stripe-height' inclusive.
;;
;; The default value is 1, so the line number of the first line of each interval
;; is printed.
;; The PostScript file should be sent to YOUR PostScript printer.
;; If you send it to ghostscript or to another PostScript printer,
;; you may get slightly different results.
-;; Anyway, as ghostscript fonts are autoload, you won't get
-;; much font info.
+;; Anyway, as ghostscript fonts are autoload, you won't get much font info.
+;;
+;; Note also that ps-print DOESN'T download any font to your printer, instead
+;; it uses the fonts resident in your printer.
;;
;;
;; How Ps-Print Deals With Faces
;;
;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
;;
+;; 20000821
+;; `ps-even-or-odd-pages'
+;;
;; 20000617
;; `ps-manual-feed', `ps-warn-paper-type', `ps-print-upside-down',
;; `ps-selected-pages', `ps-last-selected-pages',
;; Acknowledgements
;; ----------------
;;
+;; Thanks to Gord Wait <Gord_Wait@spectrumsignal.com> for
+;; `ps-user-defined-prologue' example setting for HP PostScript printer.
+;;
;; Thanks to Paul Furnanz <pfurnanz@synopsys.com> for XEmacs compatibility
;; suggestion for `ps-postscript-code-directory' variable.
;;
;; for XEmacs beta-tests.
;;
;; Thanks to Klaus Berndl <klaus.berndl@sdm.de> for user defined PostScript
-;; prologue code suggestion.
+;; prologue code suggestion and for odd/even printing suggestion.
;;
;; Thanks to Kein'ichi Handa <handa@etl.go.jp> for multi-byte buffer handling.
;;
;;; Code:
-(unless (featurep 'lisp-float-type)
- (error "`ps-print' requires floating point support"))
-
-
-;; For Emacs 20.2 and the earlier version.
+(eval-and-compile
+ (unless (featurep 'lisp-float-type)
+ (error "`ps-print' requires floating point support"))
-(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))
+ ;; For Emacs 20.2 and the earlier version.
-(or (fboundp 'string-as-multibyte)
- (defun string-as-multibyte (arg) arg))
+ (or (fboundp 'set-buffer-multibyte)
+ (defun set-buffer-multibyte (arg)
+ (setq enable-multibyte-characters arg)))
-(or (fboundp 'char-charset)
- (defun char-charset (arg) 'ascii))
+ (or (fboundp 'string-as-unibyte)
+ (defun string-as-unibyte (arg) arg))
-(or (fboundp 'charset-after)
- (defun charset-after (&optional arg)
- (char-charset (char-after arg))))
+ (or (fboundp 'string-as-multibyte)
+ (defun string-as-multibyte (arg) arg))
+ (or (fboundp 'char-charset)
+ (defun char-charset (arg) 'ascii))
-;; 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))))
+ (or (fboundp 'charset-after)
+ (defun charset-after (&optional arg)
+ (char-charset (char-after arg))))
-;; to avoid compilation gripes
-(eval-and-compile
- (mapcar #'(lambda (sym)
- (or (fboundp sym)
- (defalias sym 'ignore)))
- '(;; XEmacs
- color-instance-p
- color-instance-rgb-components
- color-name
- color-specifier-p
- copy-coding-system
- device-class
- extent-end-position
- extent-face
- extent-priority
- extent-start-position
- face-font-instance
- find-coding-system
- font-instance-properties
- make-color-instance
- map-extents)))
-
-
-(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)))
+ ;; 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))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
:group 'emacs)
(defgroup ps-print nil
- "PostScript generator for Emacs 19"
+ "PostScript generator for Emacs"
+ :link '(emacs-library-link :tag "Source Lisp File" "ps-print.el")
:prefix "ps-"
:group 'wp
:group 'postscript)
is, this string is inserted after error handler initialization and before
ps-print settings.
-It's recommended to initiate and terminate the string with \"\\n\".
-
It's strongly recommended only insert PostScript code and/or comments specific
for your printing system particularities. For example, some special
initialization that only your printing system needs.
For more information about PostScript, see:
PostScript Language Reference Manual (2nd edition)
- Adobe Systems Incorporated"
+ Adobe Systems Incorporated
+
+As an example for `ps-user-defined-prologue' setting:
+
+ ;; Setting for HP PostScript printer
+ (setq ps-user-defined-prologue
+ (concat \"<</DeferredMediaSelection true /PageSize [612 792] \"
+ \"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))
+"
:type '(choice :menu-tag "User Defined Prologue"
:tag "User Defined Prologue"
(const :tag "none" nil) string symbol)
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; a value of nil means use the value of `printer-name'
-instead. Any other value will be ignored.
-
-On MS-DOS and MS-Windows systems, a string value is taken as the name of
-the printer device or port to which PostScript files are written,
-provided `ps-lpr-command' is \"\". 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 Unix-like systems, a string value should be a name understood by lpr's -P
+option; a value of nil means use the value of `printer-name' instead.
+
+On MS-DOS and MS-Windows systems, a string value is taken as the name of the
+printer device or port to which PostScript files are written, provided
+`ps-lpr-command' is \"\". 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\".
+
+Set to t, if the utility given by `ps-lpr-command' needs an empty printer name.
+
+Any other value is treated as t, that is, an empty printer name.
+
+See also `ps-printer-name-option' for documentation."
:type '(choice :menu-tag "Printer Name"
:tag "Printer Name"
(const :tag "Same as printer-name" nil)
+ (const :tag "No Printer Name" t)
(file :tag "Print to file")
(string :tag "Pipe to ps-lpr-command"))
:group 'ps-print-printer)
+(defcustom ps-printer-name-option
+ (cond (ps-windows-system
+ "/D:")
+ (ps-lp-system
+ "-d")
+ (t
+ "-P" ))
+ "*Option for `ps-printer-name' variable (see it).
+
+On Unix-like systems, if it's been used lpr utility, it should be the string
+\"-P\"; if it's been used lp utility, it should be the string \"-d\".
+
+On MS-DOS and MS-Windows systems, if it's been used print utility, it should be
+the string \"/D:\".
+
+For any other printing utility, see the proper manual or documentation.
+
+Set to \"\" or nil, if the utility given by `ps-lpr-command' needs an empty
+option printer name option.
+
+Any other value is treated as nil, that is, an empty printer name option.
+
+This variable is used only when `ps-printer-name' is a non-empty string."
+ :type '(choice :menu-tag "Printer Name Option"
+ :tag "Printer Name Option"
+ (const :tag "None" nil)
+ (string :tag "Option"))
+ :group 'ps-print-printer)
+
(defcustom ps-lpr-command lpr-command
"*Name of program for printing a PostScript file.
-On MS-DOS and MS-Windows systems, if the value is an empty string then
-Emacs will write directly to the printer port named by `ps-printer-name'.
-The programs `print' and `nprint' (the standard print programs on Windows
-NT and Novell Netware respectively) are handled specially, using
-`ps-printer-name' as the destination for output; any other program is
-treated like `lpr' except that an explicit filename is given as the last
-argument."
+On MS-DOS and MS-Windows systems, if the value is an empty string then Emacs
+will write directly to the printer port named by `ps-printer-name'. The
+programs `print' and `nprint' (the standard print programs on Windows NT and
+Novell Netware respectively) are handled specially, using `ps-printer-name' as
+the destination for output; any other program is treated like `lpr' except that
+an explicit filename is given as the last argument."
:type 'string
:group 'ps-print-printer)
`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")
(integer :tag "To"))))
:group 'ps-print-page)
+(defcustom ps-even-or-odd-pages nil
+ "*Specify if it prints even/odd pages.
+
+Valid values are:
+
+ nil print all pages.
+
+ `even' print only even pages.
+
+ `odd' print only odd pages.
+
+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)
+ (const :tag "Only Even Pages" even)
+ (const :tag "Only Odd Pages" odd))
+ :group 'ps-print-page)
+
(defcustom ps-print-control-characters 'control-8-bit
"*Specify the printable form for control and 8-bit characters.
That is, instead of sending, for example, a ^D (\\004) to printer,
(defcustom ps-line-number-start 1
"*Specify the starting point in the interval given by `ps-line-number-step'.
-For example, if `ps-line-number-step' is set to 3 and `ps-line-number-start' is set to 3, the
-printing will look like:
+For example, if `ps-line-number-step' is set to 3 and `ps-line-number-start' is
+set to 3, the printing will look like:
one line
one line
to get the line
`3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
- add the values to `ps-font-info-database'.
-You can get all the fonts of YOUR printer using `ReportAllFontInfo'."
+You can get all the fonts of YOUR printer using `ReportAllFontInfo'.
+
+Note also that ps-print DOESN'T download any font to your printer, instead
+it uses the fonts resident in your printer."
:type '(repeat (list :tag "Font Definition"
(symbol :tag "Font Family")
(cons :format "%v"
;;; 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
\(setq ps-print-color-p %s
ps-lpr-command %S
ps-lpr-switches %s
- ps-printer-name %S
+ ps-printer-name %s
+ ps-printer-name-option %s
ps-print-region-function %s
ps-manual-feed %S
ps-header-font-size %s
ps-header-title-font-size %s
+ ps-even-or-odd-pages %s
ps-selected-pages %s
ps-last-selected-pages %s)
ps-print-color-p
ps-lpr-command
(ps-print-quote ps-lpr-switches)
- ps-printer-name
+ (ps-print-quote ps-printer-name)
+ (ps-print-quote ps-printer-name-option)
(ps-print-quote ps-print-region-function)
ps-manual-feed
(ps-print-quote ps-paper-type)
(ps-print-quote ps-header-font-family)
(ps-print-quote ps-header-font-size)
(ps-print-quote ps-header-title-font-size)
+ (ps-print-quote ps-even-or-odd-pages)
(ps-print-quote ps-selected-pages)
(ps-print-quote ps-last-selected-pages)))
(t
sym)))
-(defvar ps-print-emacs-type
- (cond ((string-match "XEmacs" emacs-version) 'xemacs)
- ((string-match "Lucid" emacs-version) 'lucid)
- ((string-match "Epoch" emacs-version) 'epoch)
- (t 'emacs)))
-(if (memq ps-print-emacs-type '(lucid xemacs))
- (if (< emacs-minor-version 12)
- (setq ps-print-color-p nil))
- (require 'faces)) ; face-font, face-underline-p,
+(eval-and-compile
+ (defvar ps-print-emacs-type
+ (cond ((string-match "XEmacs" emacs-version) 'xemacs)
+ ((string-match "Lucid" emacs-version) 'lucid)
+ ((string-match "Epoch" emacs-version) 'epoch)
+ (t 'emacs)))
+
+ (if (memq ps-print-emacs-type '(lucid xemacs))
+ (if (< emacs-minor-version 12)
+ (setq ps-print-color-p nil))
+ (require 'faces)) ; face-font, face-underline-p,
; x-font-regexp
-;; 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.
-(cond ((and (eq ps-print-emacs-type 'xemacs)
- (>= emacs-minor-version 12)) ; xemacs
- (defun ps-color-device ()
- (eq (device-class) 'color))
- )
+ ;; Return t if the device (which can be changed during an emacs session)
+ ;; can handle colors.
+ ;; This function is not yet implemented for GNU emacs.
+ (cond ((and (eq ps-print-emacs-type 'xemacs)
+ (>= emacs-minor-version 12)) ; xemacs
+ (defun ps-color-device ()
+ (eq (ps-x-device-class) 'color)))
+
+ (t ; emacs
+ (defun ps-color-device ()
+ (if (fboundp 'color-values)
+ (ps-e-color-values "Green")
+ t))))
+
+
+ (defun ps-mapper (extent list)
+ (nconc list
+ (list (list (ps-x-extent-start-position extent) 'push extent)
+ (list (ps-x-extent-end-position extent) 'pull extent)))
+ nil)
+
+ (defun ps-extent-sorter (a b)
+ (< (ps-x-extent-priority a) (ps-x-extent-priority b)))
+
+ (defun ps-xemacs-face-kind-p (face kind kind-regex)
+ (let* ((frame-font (or (ps-x-face-font-instance face)
+ (ps-x-face-font-instance 'default)))
+ (kind-cons
+ (and frame-font
+ (assq kind
+ (ps-x-font-instance-properties frame-font))))
+ (kind-spec (cdr-safe kind-cons))
+ (case-fold-search t))
+ (and kind-spec (string-match kind-regex kind-spec))))
+
+ (defun ps-xemacs-color-name (color)
+ (if (ps-x-color-specifier-p color)
+ (ps-x-color-name color)
+ color))
+
+ (cond ((eq ps-print-emacs-type 'emacs) ; emacs
+
+ (defun ps-color-values (x-color)
+ (cond
+ ((fboundp 'color-values)
+ (ps-e-color-values x-color))
+ ((fboundp 'x-color-values)
+ (ps-e-x-color-values x-color))
+ (t
+ (error "No available function to determine X color values."))))
+
+ (defalias 'ps-face-foreground-name 'face-foreground)
+ (defalias 'ps-face-background-name 'face-background)
+
+ (defun ps-face-bold-p (face)
+ (or (face-bold-p face)
+ (memq face ps-bold-faces)))
+
+ (defun ps-face-italic-p (face)
+ (or (face-italic-p face)
+ (memq face ps-italic-faces)))
+ )
+ ; xemacs
+ ; lucid
+ (t ; epoch
+
+ (or (ps-x-find-coding-system 'raw-text-unix)
+ (ps-x-copy-coding-system 'no-conversion-unix 'raw-text-unix))
+
+ (defun ps-color-values (x-color)
+ (let ((color (ps-xemacs-color-name x-color)))
+ (cond
+ ((fboundp 'x-color-values)
+ (ps-e-x-color-values color))
+ ((and (fboundp 'color-instance-rgb-components)
+ (ps-color-device))
+ (ps-x-color-instance-rgb-components
+ (if (ps-x-color-instance-p x-color)
+ x-color
+ (ps-x-make-color-instance color))))
+ (t
+ (error "No available function to determine X color values.")))))
- (t ; emacs
- (defun ps-color-device ()
- t)
- ))
+ (defun ps-face-foreground-name (face)
+ (ps-xemacs-color-name (face-foreground face)))
+
+ (defun ps-face-background-name (face)
+ (ps-xemacs-color-name (face-background face)))
+
+ (defun ps-face-bold-p (face)
+ (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
+ (memq face ps-bold-faces))) ; Kludge-compatible
+
+ (defun ps-face-italic-p (face)
+ (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o")
+ (ps-xemacs-face-kind-p face 'SLANT "i\\|o")
+ (memq face ps-italic-faces))) ; Kludge-compatible
+ )))
+
+
+(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.
+ (mapcar #'(lambda (value) (/ value ps-print-color-scale))
+ (ps-color-values color)))
+
+
+(defun ps-face-underlined-p (face)
+ (or (face-underline-p face)
+ (memq face ps-underlined-faces)))
(require 'time-stamp)
(defvar ps-print-prologue-2 ""
"ps-print PostScript prologue end.")
-(defvar ps-print-duplex-feature ""
- "ps-print PostScript duplex feature.")
-
;; Start Editing Here:
(defvar ps-source-buffer nil)
(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)
(defvar ps-height-remaining nil)
(defvar ps-width-remaining nil)
-(defvar ps-print-color-scale nil)
-
(defvar ps-font-size-internal nil)
(defvar ps-header-font-size-internal nil)
(defvar ps-header-title-font-size-internal nil)
(defun ps-font-lock-face-attributes ()
(and (boundp 'font-lock-mode) (symbol-value 'font-lock-mode)
(boundp 'font-lock-face-attributes)
- (let ((face-attributes font-lock-face-attributes))
+ (let ((face-attributes (symbol-value 'font-lock-face-attributes)))
(while face-attributes
(let* ((face-attribute
(car (prog1 face-attributes
;; Internal functions and variables
-(make-local-hook 'ps-print-hook)
-(make-local-hook 'ps-print-begin-sheet-hook)
-(make-local-hook 'ps-print-begin-page-hook)
-(make-local-hook 'ps-print-begin-column-hook)
+(defvar ps-print-hook nil)
+(defvar ps-print-begin-sheet-hook nil)
+(defvar ps-print-begin-page-hook nil)
+(defvar ps-print-begin-column-hook nil)
(defun ps-print-without-faces (from to &optional filename region-p)
".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)
(< ps-last-page ps-page-postscript)))))
-(defsubst ps-print-page-p ()
- (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)))
+(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)))))
(mapcar
#'(lambda (text)
(setq ps-background-text-count (1+ ps-background-text-count))
- (ps-output (format "/ShowBackText-%d {\n" ps-background-text-count))
+ (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count))
(ps-output-string (nth 0 text)) ; text
(ps-output
"\n"
(ps-float-format (nth 5 text) 0.85) ; gray
(ps-float-format (nth 1 text) "0") ; x position
(ps-float-format (nth 2 text) "0") ; y position
- "\nShowBackText} def\n")
+ "\nShowBackText}def\n")
(ps-background-pages (nthcdr 7 text) ; page list
(format "ShowBackText-%d\n"
ps-background-text-count)))
(when (file-readable-p image-file)
(setq ps-background-image-count (1+ ps-background-image-count))
(ps-output
- (format "/ShowBackImage-%d {\n--back-- "
+ (format "/ShowBackImage-%d{\n--back-- "
ps-background-image-count)
(ps-float-format (nth 5 image) 0.0) ; rotation
(ps-float-format (nth 3 image) 1.0) ; x scale
(- (+ (/ (- (aref box 3) (aref box 1)) 2.0)
(aref box 1)))))
t)))))
- (ps-output "\nEndBackImage} def\n")
+ (ps-output "\nEndBackImage}def\n")
(ps-background-pages (nthcdr 6 image) ; page list
(format "ShowBackImage-%d\n"
ps-background-image-count)))))
(if has-local-background
(ps-output (aref range 2))
(setq has-local-background t)
- (ps-output "/printLocalBackground {\n"
+ (ps-output "/printLocalBackground{\n"
(aref range 2)))))
ps-background-pages)
- (and has-local-background (ps-output "} def\n"))))
+ (and has-local-background (ps-output "}def\n"))))
;; Return a list of the distinct elements of LIST.
(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
ps-spool-duplex
ps-switch-header))
(ps-output-boolean "ShowNofN " ps-show-n-of-n)
- (ps-output-boolean "DuplexValue " ps-spool-duplex)
- (ps-output-boolean "TumbleValue " tumble)
(let ((line-height (ps-line-height 'ps-font-for-text)))
(ps-output (format "/LineHeight %s def\n" line-height)
(ps-output "\n" ps-print-prologue-1)
- (ps-output "\n/printGlobalBackground {\n")
+ (ps-output "\n/printGlobalBackground{\n")
(ps-output-list ps-background-all-pages)
- (ps-output "} def\n/printLocalBackground {\n} def\n")
+ (ps-output "}def\n/printLocalBackground{\n}def\n")
;; Header fonts
- (ps-output (format "/h0 %s (%s) cvn DefFont\n" ; /h0 14 /Helvetica-Bold DefFont
+ (ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14 /Helvetica-Bold DefFont
ps-header-title-font-size-internal
(ps-font 'ps-font-for-header 'bold))
- (format "/h1 %s (%s) cvn DefFont\n" ; /h1 12 /Helvetica DefFont
+ (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12 /Helvetica DefFont
ps-header-font-size-internal
(ps-font 'ps-font-for-header 'normal)))
(let ((font (ps-font-alist 'ps-font-for-text))
(i 0))
(while font
- (ps-output (format "/f%d %s (%s) cvn DefFont\n"
+ (ps-output (format "/f%d %s(%s)cvn DefFont\n"
i
ps-font-size-internal
(ps-font 'ps-font-for-text (car (car font)))))
(ps-boolean-capitalized ps-spool-duplex)
" *Tumble "
(ps-boolean-capitalized tumble)
- "\n\n"
- ps-print-duplex-feature
- "\n%%EndFeature\n")))
+ "\nUseSetpagedevice\n{BMark/Duplex "
+ (ps-boolean-constant ps-spool-duplex)
+ "/Tumble "
+ (ps-boolean-constant tumble)
+ " EMark setpagedevice}\n{statusdict begin "
+ (ps-boolean-constant ps-spool-duplex)
+ " setduplexmode "
+ (ps-boolean-constant tumble)
+ " settumble end}ifelse\n%%EndFeature\n")))
(ps-output "\n%%BeginFeature: *ManualFeed "
(ps-boolean-capitalized ps-manual-feed)
"\nBMark /ManualFeed "
(setq ps-postscript-code-directory
(concat ps-postscript-code-directory "/"))))
(or (equal ps-mark-code-directory ps-postscript-code-directory)
- (setq ps-print-prologue-0 (ps-prologue-file 0)
- ps-print-prologue-1 (ps-prologue-file 1)
- ps-print-prologue-2 (ps-prologue-file 2)
- ps-print-duplex-feature (ps-prologue-file 3)
- ps-mark-code-directory ps-postscript-code-directory))
+ (setq ps-print-prologue-0 (ps-prologue-file 0)
+ ps-print-prologue-1 (ps-prologue-file 1)
+ ps-print-prologue-2 (ps-prologue-file 2)
+ ps-mark-code-directory ps-postscript-code-directory))
;; selected pages
(let (new page)
(while ps-selected-pages
))
-(defmacro ps-page-number ()
- `(1+ (/ (1- ps-page-count) ps-number-of-columns)))
-
-(defun ps-end-file (needs-begin-file)
- (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 ()
(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 print-posterior (> 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)
(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)
(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)))
(if (re-search-forward ps-control-or-escape-regexp to t)
;; region with some control characters or some multi-byte characters
(let* ((match-point (match-beginning 0))
- (match (char-after match-point))
- (composition (find-composition from (1+ match-point))))
+ (match (char-after match-point))
+ (composition (ps-e-find-composition from (1+ match-point))))
(if composition
(if (and (nth 2 composition)
(<= (car composition) match-point))
(composition ; a composite sequence
(ps-plot 'ps-mule-plot-composition match-point (point) bg-color))
- ; characters from ^@ to ^_ and
((> match 255) ; a multi-byte character
(let* ((charset (char-charset match))
- (composition (find-composition match-point to))
+ (composition (ps-e-find-composition match-point to))
(stop (if (nth 2 composition) (car composition) to)))
(or (eq charset 'composition)
(while (and (< (point) stop) (eq (charset-after) charset))
(forward-char 1)))
(ps-plot 'ps-mule-plot-string match-point (point) bg-color)))
-
+ ; characters from ^@ to ^_ and
(t ; characters from 127 to 255
(ps-control-character match)))
(setq from (point)))
(ps-output-string str)
(ps-output " S\n")))
-(defun ps-color-scale (color)
- ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
- (mapcar #'(lambda (value) (/ value ps-print-color-scale))
- (ps-color-values color)))
-
-
-(defun ps-xemacs-color-name (color)
- (if (color-specifier-p color)
- (color-name color)
- color))
-
-
-(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.")))
- )
- ; xemacs
- ; lucid
- (t ; epoch
-
- (or (find-coding-system 'raw-text-unix)
- (copy-coding-system 'no-conversion-unix 'raw-text-unix))
-
- (defun ps-color-values (x-color)
- (let ((color (ps-xemacs-color-name x-color)))
- (cond
- ((fboundp 'x-color-values)
- (x-color-values color))
- ((and (fboundp 'color-instance-rgb-components)
- (ps-color-device))
- (color-instance-rgb-components
- (if (color-instance-p x-color)
- x-color
- (make-color-instance color))))
- (t
- (error "No available function to determine X color values.")))))
- ))
-
(defun ps-face-attributes (face)
"Return face attribute vector.
(goto-char to))
-(defun ps-xemacs-face-kind-p (face kind kind-regex)
- (let* ((frame-font (or (face-font-instance face)
- (face-font-instance 'default)))
- (kind-cons (and frame-font
- (assq kind
- (font-instance-properties frame-font))))
- (kind-spec (cdr-safe kind-cons))
- (case-fold-search t))
- (and kind-spec (string-match kind-regex kind-spec))))
-
-
-(cond ((eq ps-print-emacs-type 'emacs) ; emacs
-
- (defalias 'ps-face-foreground-name 'face-foreground)
- (defalias 'ps-face-background-name 'face-background)
-
- (defun ps-face-bold-p (face)
- (or (face-bold-p face)
- (memq face ps-bold-faces)))
-
- (defun ps-face-italic-p (face)
- (or (face-italic-p face)
- (memq face ps-italic-faces)))
- )
- ; xemacs
- ; lucid
- (t ; epoch
- (defun ps-face-foreground-name (face)
- (ps-xemacs-color-name (face-foreground face)))
-
- (defun ps-face-background-name (face)
- (ps-xemacs-color-name (face-background face)))
-
- (defun ps-face-bold-p (face)
- (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
- (memq face ps-bold-faces))) ; Kludge-compatible
-
- (defun ps-face-italic-p (face)
- (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o")
- (ps-xemacs-face-kind-p face 'SLANT "i\\|o")
- (memq face ps-italic-faces))) ; Kludge-compatible
- ))
-
-
-(defun ps-face-underlined-p (face)
- (or (face-underline-p face)
- (memq face ps-underlined-faces)))
-
-
;; Ensure that face-list is fbound.
(or (fboundp 'face-list) (defalias 'face-list 'list-faces))
(ps-face-background-name face))))
-(cond ((not (eq ps-print-emacs-type 'emacs))
- ; xemacs
- ; lucid
- ; epoch
- (defun ps-mapper (extent list)
- (nconc list (list (list (extent-start-position extent) 'push extent)
- (list (extent-end-position extent) 'pull extent)))
- nil)
-
- (defun ps-extent-sorter (a b)
- (< (extent-priority a) (extent-priority b)))
- ))
-
-
+;; to avoid compilation gripes
(defun ps-print-ensure-fontified (start end)
- (and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode)
- (lazy-lock-fontify-region 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)
;; Some initialization...
;; Build the list of extents...
(let ((a (cons 'dummy nil))
record type extent extent-list)
- (map-extents 'ps-mapper nil from to a)
+ (ps-x-map-extents 'ps-mapper nil from to a)
(setq a (sort (cdr a) 'car-less-than-car)
extent-list nil)
;; XEmacs 19.12: for some reason, we're getting into a
;; situation in which some of the records have
;; positions less than 'from'. Since we've narrowed
- ;; the buffer, this'll generate errors. This is a
- ;; hack, but don't call ps-plot-with-face unless from >
- ;; point-min.
- (and (>= from (point-min)) (<= position (point-max))
- (ps-plot-with-face from position face))
+ ;; the buffer, this'll generate errors. This is a hack,
+ ;; but don't call ps-plot-with-face unless from > point-min.
+ (and (>= from (point-min))
+ (ps-plot-with-face from (min position (point-max)) face))
(cond
((eq type 'push)
- (and (extent-face extent)
+ (and (ps-x-extent-face extent)
(setq extent-list (sort (cons extent extent-list)
'ps-extent-sorter))))
'ps-extent-sorter))))
(setq face (if extent-list
- (extent-face (car extent-list))
+ (ps-x-extent-face (car extent-list))
'default)
from position
a (cdr a)))))
(goto-char (point-min))
(or (looking-at (regexp-quote ps-adobe-tag))
(setq needs-begin-file t))
- (save-excursion
- (set-buffer ps-source-buffer)
- (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)
+ (save-excursion
+ (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)
(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.
(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))
-(defvar ps-printer-name-option
- (cond (ps-windows-system
- "-P")
- (ps-lp-system
- "-d")
- (t
- "-P" )))
-
-
;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
(defun ps-do-despool (filename)
(if (or (not (boundp 'ps-spool-buffer))
(and (boundp 'printer-name)
printer-name)))
(ps-lpr-switches
- (append (and (stringp ps-printer-name)
- (list (concat ps-printer-name-option
- ps-printer-name)))
- ps-lpr-switches)))
+ (append ps-lpr-switches
+ (and (stringp ps-printer-name)
+ (string< "" ps-printer-name)
+ (list (concat
+ (and (stringp ps-printer-name-option)
+ ps-printer-name-option)
+ ps-printer-name))))))
(apply (or ps-print-region-function 'call-process-region)
(point-min) (point-max) ps-lpr-command nil
(and (fboundp 'start-process) 0)
HCoop / bpt / emacs.git / blobdiff