;; 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/03/21 00:02:42 vinicius>
-;; Version: 5.1.1
+;; Time-stamp: <2000/06/05 14:40:03 vinicius>
+;; Version: 5.2.2
-(defconst ps-print-version "5.1.1"
- "ps-print.el, v 5.1.1 <2000/03/21 vinicius>
+(defconst ps-print-version "5.2.2"
+ "ps-print.el, v 5.2.2 <2000/06/05 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 report the version of Emacs, if any, that ps-print was
-distributed with.
+Emacs without changes to the version number. When reporting bugs, please also
+report the version of Emacs, if any, that ps-print was distributed with.
Please send all bug fixes and enhancements to
Vinicius Jose Latorre <vinicius@cpqd.com.br>.
;; See definition of `call-process-region' for calling conventions. The fourth
;; and the sixth arguments are both nil.
;;
+;; The variable `ps-manual-feed' indicates if the printer will manually feed
+;; paper. If it's nil, automatic feeding takes place. If it's non-nil, manual
+;; 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.
+;;
;;
;; The Page Layout
;; ---------------
;; 1 inch == 2.54 cm == 72 points
;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
;;
-;; The variable `ps-paper-type' determines the size of paper ps-print
-;; formats for; it should contain one of the symbols:
-;; `a4' `a3' `letter' `legal' `letter-small' `tabloid'
-;; `ledger' `statement' `executive' `a4small' `b4' `b5'
-;;
-;; The variable `ps-landscape-mode' determines the orientation
-;; of the printing on the page:
-;; nil means `portrait' mode, non-nil means `landscape' mode.
+;; The variable `ps-paper-type' determines the size of paper ps-print formats
+;; for; it should contain one of the symbols: `a4' `a3' `letter' `legal'
+;; `letter-small' `tabloid' `ledger' `statement' `executive' `a4small' `b4'
+;; `b5'.
+;;
+;; If variable `ps-warn-paper-type' is nil, it's *not* given an error if
+;; PostScript printer doesn't have a paper with the size indicated by
+;; `ps-paper-type', instead it uses the default paper size. If variable
+;; `ps-warn-paper-type' is non-nil, it's given an error if PostScript printer
+;; doesn't have a paper with the size indicated by `ps-paper-type'. It's used
+;; when `ps-spool-config' is set to `setpagedevice' (see section Duplex
+;; Printers). The default value is non-nil (it gives an error).
+;;
+;; The variable `ps-landscape-mode' determines the orientation of the printing
+;; on the page: nil means `portrait' mode, non-nil means `landscape' mode.
;; There is no oblique mode yet, though this is easy to do in ps.
;;
-;; In landscape mode, the text is NOT scaled: you may print 70 lines
-;; in portrait mode and only 50 lignes in landscape mode.
-;; The margins represent margins in the printed paper:
-;; the top margin is the margin between the top of the page
+;; In landscape mode, the text is NOT scaled: you may print 70 lines in portrait
+;; mode and only 50 lines in landscape mode. The margins represent margins in
+;; the printed paper: the top margin is the margin between the top of the page
;; and the printed header, whatever the orientation is.
;;
-;; The variable `ps-number-of-columns' determines the number of columns
-;; both in landscape and portrait mode.
+;; The variable `ps-number-of-columns' determines the number of columns both in
+;; landscape and portrait mode.
;; You can use:
-;; - (the standard) one column portrait mode
-;; - (my favorite) two columns landscape mode (which spares trees)
-;; but also
+;; - (the standard) one column portrait mode.
+;; - (my favorite) two columns landscape mode (which spares trees).
+;; but also:
;; - one column landscape mode for files with very long lines.
-;; - multi-column portrait or landscape mode
+;; - multi-column portrait or landscape mode.
+;;
+;; The variable `ps-print-upside-down' determines other orientation for printing
+;; page: nil means `normal' printing, non-nil means `upside-down' printing. The
+;; default value is nil (`normal' printing).
+;;
+;; The `upside-down' orientation can be used in portrait or landscape mode.
;;
;;
;; Horizontal layout
;; To print only one header at the top of each page,
;; set `ps-print-only-one-header' to t.
;;
+;; To switch headers, set `ps-switch-header' to:
+;;
+;; nil Never switch headers.
+;;
+;; t Always switch headers.
+;;
+;; duplex Switch headers only when duplexing is on, that is, when
+;; `ps-spool-duplex' is non-nil (see Duplex Printers).
+;;
+;; Any other value is treated as t. The default value is `duplex'.
+;;
;; The font family and size of text in the header are determined
;; by the variables `ps-header-font-family', `ps-header-font-size' and
;; `ps-header-title-font-size' (see below).
;; title line height to insert between the header frame and the text
;; it contains, both in the vertical and horizontal directions:
;; .5 means half a line.
-
+;;
;; Page numbers are printed in `n/m' format, indicating page n of m pages;
;; to omit the total page count and just print the page number,
;; set `ps-show-n-of-n' to nil.
;; This is the default value.
;;
;; system catch the error and send back the error message to
-;; printing system.
+;; printing system. This is useful only if printing system
+;; send back an email reporting the error, or if there is
+;; some other alternative way to report back the error from
+;; the system to you.
;;
;; paper-and-system catch the error, print on paper the error message and
;; send back the error message to printing system.
;; The variable `ps-line-number' specifies whether to number each line;
;; non-nil means do so. The default is nil (don't number each line).
;;
+;; The variable `ps-line-number-step' specifies the interval that line number is
+;; printed. For example, if `ps-line-number-step' is set to 2, the printing
+;; will look like:
+;;
+;; 1 one line
+;; one line
+;; 3 one line
+;; one line
+;; 5 one line
+;; one line
+;; ...
+;;
+;; Valid values are:
+;;
+;; integer an integer that specifies the interval that line number is
+;; printed. If it's lesser than or equal to zero, it's used the
+;; value 1.
+;;
+;; `zebra' specifies that only the line number of the first line in a zebra
+;; stripe is to be printed.
+;;
+;; Any other value is treated as `zebra'.
+;; The default value is 1, so each line number is printed.
+;;
+;; The variable `ps-line-number-start' specifies 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:
+;;
+;; one line
+;; one line
+;; 3 one line
+;; one line
+;; one line
+;; 6 one line
+;; one line
+;; one line
+;; 9 one line
+;; one line
+;; ...
+;;
+;; The values for `ps-line-number-start':
+;;
+;; * If `ps-line-number-step' is an integer, must be between 1 and the value
+;; 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.
+;;
+;; The default value is 1, so the line number of the first line of each interval
+;; is printed.
+;;
;;
;; Zebra Stripes
;; -------------
;; The variable `ps-zebra-stripes' controls whether to print zebra stripes.
;; Non-nil means yes, nil means no. The default is nil.
;;
-;; The variable `ps-zebra-gray' controls the zebra stripes gray scale.
-;; It should be a float number between 0.0 (black color) and 1.0 (white color).
-;; The default is 0.95.
+;; The variable `ps-zebra-color' controls the zebra stripes gray scale or RGB
+;; color. It should be a float number between 0.0 (black color) and 1.0 (white
+;; color), a string which is a color name, or a list of 3 numbers which
+;; corresponds to the Red Green Blue color scale.
+;; The default is 0.95 (or "gray95", or '(0.95 0.95 0.95)).
+;;
+;; The variable `ps-zebra-stripe-follow' specifies if zebra stripe should
+;; continue on next page or restart on each page. If `ps-zebra-stripe-follow'
+;; is nil, zebra stripe is restarted on each page. If `ps-zebra-stripe-follow'
+;; is non-nil, zebra stripe continues on next page. Visually, we have:
+;;
+;; `ps-zebra-stripe-follow' `ps-zebra-stripe-follow'
+;; is nil is non-nil
+;; Current Page ------------------------ ------------------------
+;; 1 XXXXXXXXXXXXXXXXXXXXX 1 XXXXXXXXXXXXXXXXXXXXX
+;; 2 XXXXXXXXXXXXXXXXXXXXX 2 XXXXXXXXXXXXXXXXXXXXX
+;; 3 XXXXXXXXXXXXXXXXXXXXX 3 XXXXXXXXXXXXXXXXXXXXX
+;; 4 4
+;; 5 5
+;; 6 6
+;; 7 XXXXXXXXXXXXXXXXXXXXX 7 XXXXXXXXXXXXXXXXXXXXX
+;; 8 XXXXXXXXXXXXXXXXXXXXX 8 XXXXXXXXXXXXXXXXXXXXX
+;; ------------------------ ------------------------
+;; Next Page ------------------------ ------------------------
+;; 9 XXXXXXXXXXXXXXXXXXXXX 9 XXXXXXXXXXXXXXXXXXXXX
+;; 10 XXXXXXXXXXXXXXXXXXXXX 10
+;; 11 XXXXXXXXXXXXXXXXXXXXX 11
+;; 12 12
+;; 13 13 XXXXXXXXXXXXXXXXXXXXX
+;; 14 14 XXXXXXXXXXXXXXXXXXXXX
+;; 15 XXXXXXXXXXXXXXXXXXXXX 15 XXXXXXXXXXXXXXXXXXXXX
+;; 16 XXXXXXXXXXXXXXXXXXXXX 16
+;; ------------------------ ------------------------
;;
;; See also section How Ps-Print Has A Text And/Or Image On Background.
;;
;; rebuilt when ps-print is invoked, set the variable
;; `ps-always-build-face-reference' to t.
;;
+;; If you need to print without worrying about face background color, set the
+;; variable `ps-use-face-background' which specifies if face background should
+;; be used. Valid values are:
+;;
+;; t always use face background color.
+;; nil never use face background color.
+;; (face...) list of faces whose background color will be used.
+;;
+;; Any other value will be treated as t.
+;; The default value is t.
+;;
;;
;; How Ps-Print Deals With Color
;; -----------------------------
;; defined and embeds color information in the PostScript image.
;; The default foreground and background colors are defined by the
;; variables `ps-default-fg' and `ps-default-bg'.
-;; On black-and-white printers, colors are displayed in grayscale.
+;; On black-and-white printers, colors are displayed in gray scale.
;; To turn off color output, set `ps-print-color-p' to nil.
;;
;;
;;
;; The printing order is:
;;
-;; 1. Print zebra stripes
-;; 2. Print background texts that it should be on all pages
-;; 3. Print background images that it should be on all pages
-;; 4. Print background texts only for current page (if any)
-;; 5. Print background images only for current page (if any)
-;; 6. Print header
-;; 7. Print buffer text (with faces, if specified) and line number
+;; 1. Print background color
+;; 2. Print zebra stripes
+;; 3. Print background texts that it should be on all pages
+;; 4. Print background images that it should be on all pages
+;; 5. Print background texts only for current page (if any)
+;; 6. Print background images only for current page (if any)
+;; 7. Print header
+;; 8. Print buffer text (with faces, if specified) and line number
;;
;;
;; Utilities
;; [vinicius] 990703 Vinicius Jose Latorre <vinicius@cpqd.com.br>
;;
;; Better customization.
-;; `ps-banner-page-when-duplexing' and `ps-zebra-gray'.
+;; `ps-banner-page-when-duplexing' and `ps-zebra-color'.
;;
;; [vinicius] 990513 Vinicius Jose Latorre <vinicius@cpqd.com.br>
;;
;; Acknowledgements
;; ----------------
;;
+;; Thanks to Paul Furnanz <pfurnanz@synopsys.com> for XEmacs compatibility
+;; suggestion for `ps-postscript-code-directory' variable.
+;;
+;; Thanks to David X Callaway <dxc@xprt.net> for helping debugging PostScript
+;; level 1 compatibility.
+;;
+;; Thanks to Colin Marquardt <colin.marquardt@usa.alcatel.com> for upside-down,
+;; line number step, line number start and zebra stripe follow suggestions, and
+;; for XEmacs beta-tests.
+;;
;; Thanks to Klaus Berndl <klaus.berndl@sdm.de> for user defined PostScript
;; prologue code suggestion.
;;
(char-charset (char-after arg))))
+(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))))
+
+
+(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)))
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User Variables:
:tag "Vertical"
:group 'ps-print)
-(defgroup ps-print-header nil
+(defgroup ps-print-headers nil
"Headers layout"
:prefix "ps-"
:tag "Header"
:tag "Page"
:group 'ps-print)
+(defgroup ps-print-miscellany nil
+ "Miscellany customization"
+ :prefix "ps-"
+ :tag "Miscellany"
+ :group 'ps-print)
+
(defcustom ps-error-handler-message 'paper
"*Specify where the error handler message should be sent.
`paper' catch the error and print on paper the error message.
`system' catch the error and send back the error message to
- printing system.
+ printing system. This is useful only if printing system
+ send back an email reporting the error, or if there is
+ some other alternative way to report back the error from
+ the system to you.
`paper-and-system' catch the error, print on paper the error message and
send back the error message to printing system.
Any other value is treated as `paper'."
- :type '(choice :tag "Error Handler Message"
+ :type '(choice :menu-tag "Error Handler Message"
+ :tag "Error Handler Message"
(const none) (const paper)
(const system) (const paper-and-system))
- :group 'ps-print)
+ :group 'ps-print-miscellany)
(defcustom ps-user-defined-prologue nil
"*User defined PostScript prologue code inserted before all prologue code.
For more information about PostScript, see:
PostScript Language Reference Manual (2nd edition)
Adobe Systems Incorporated"
- :type '(choice :tag "User Defined Prologue"
- string symbol (other :tag "nil" nil))
- :group 'ps-print)
+ :type '(choice :menu-tag "User Defined Prologue"
+ :tag "User Defined Prologue"
+ (const :tag "none" nil) string symbol)
+ :group 'ps-print-miscellany)
(defcustom ps-print-prologue-header nil
"*PostScript prologue header comments besides that ps-print generates.
PostScript Language Reference Manual (2nd edition)
Adobe Systems Incorporated
Appendix G: Document Structuring Conventions -- Version 3.0"
- :type '(choice :tag "Prologue Header"
- string symbol (other :tag "nil" nil))
- :group 'ps-print)
+ :type '(choice :menu-tag "Prologue Header"
+ :tag "Prologue Header"
+ (const :tag "none" nil) string symbol)
+ :group 'ps-print-miscellany)
(defcustom ps-printer-name (and (boundp 'printer-name)
printer-name)
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\"."
- :type '(choice :tag "Printer Name"
- file (other :tag "Pipe to ps-lpr-command" pipe))
+ :type '(choice :menu-tag "Printer Name"
+ :tag "Printer Name"
+ (const :tag "Same as printer-name" nil)
+ (file :tag "Print to file")
+ (string :tag "Pipe to ps-lpr-command"))
:group 'ps-print-printer)
(defcustom ps-lpr-command lpr-command
(defcustom ps-lpr-switches lpr-switches
"*A list of extra switches to pass to `ps-lpr-command'."
- :type '(repeat string)
+ :type '(repeat :tag "PostScript lpr Switches"
+ (choice string symbol (repeat sexp)))
:group 'ps-print-printer)
(defcustom ps-print-region-function nil
:type 'function
:group 'ps-print-printer)
+(defcustom ps-manual-feed nil
+ "*Non-nil means the printer will manually feed paper.
+
+If it's nil, automatic feeding takes place."
+ :type 'boolean
+ :group 'ps-print-printer)
+
;;; Page layout
;; All page dimensions are in PostScript points.
wid)))
:group 'ps-print-page)
+(defcustom ps-warn-paper-type t
+ "*Non-nil means give an error if paper size is not equal to `ps-paper-type'.
+
+It's used when `ps-spool-config' is set to `setpagedevice'."
+ :type 'boolean
+ :group 'ps-print-page)
+
(defcustom ps-landscape-mode nil
"*Non-nil means print in landscape mode."
:type 'boolean
:group 'ps-print-page)
+(defcustom ps-print-upside-down nil
+ "*Non-nil means print upside-down."
+ :type 'boolean
+ :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,
current font.
Any other value is treated as nil."
- :type '(choice :tag "Control Char"
+ :type '(choice :menu-tag "Control Char"
+ :tag "Control Char"
(const 8-bit) (const control-8-bit)
- (const control) (other :tag "nil" nil))
- :group 'ps-print)
+ (const control) (const :tag "nil" nil))
+ :group 'ps-print-miscellany)
(defcustom ps-n-up-printing 1
"*Specify the number of pages per sheet paper."
12 9 6 3 10 7 4 1
Any other value is treated as `left-top'."
- :type '(choice :tag "N-Up Filling"
+ :type '(choice :menu-tag "N-Up Filling"
+ :tag "N-Up Filling"
(const left-top) (const left-bottom)
(const right-top) (const right-bottom)
(const top-left) (const bottom-left)
(defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
"*Specify the number of columns"
:type 'number
- :group 'ps-print)
+ :group 'ps-print-miscellany)
(defcustom ps-zebra-stripes nil
"*Non-nil means print zebra stripes.
-See also documentation for `ps-zebra-stripe-height' and `ps-zebra-gray'."
+See also documentation for `ps-zebra-stripe-height' and `ps-zebra-color'."
:type 'boolean
:group 'ps-print-zebra)
(defcustom ps-zebra-stripe-height 3
"*Number of zebra stripe lines.
-See also documentation for `ps-zebra-stripes' and `ps-zebra-gray'."
+See also documentation for `ps-zebra-stripes' and `ps-zebra-color'."
:type 'number
:group 'ps-print-zebra)
-(defcustom ps-zebra-gray 0.95
- "*Zebra stripe gray scale.
+(defcustom ps-zebra-color 0.95
+ "*Zebra stripe gray scale or RGB color.
See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."
- :type 'number
+ :type '(choice :menu-tag "Zebra Gray/Color"
+ :tag "Zebra Gray/Color"
+ (number :tag "Gray Scale" :value 0.95)
+ (string :tag "Color Name" :value "gray95")
+ (list :tag "RGB Color" :value (0.95 0.95 0.95)
+ (number :tag "Red")
+ (number :tag "Green")
+ (number :tag "Blue")))
+ :group 'ps-print-zebra)
+
+(defcustom ps-zebra-stripe-follow nil
+ "*Non-nil means zebra stripe continues on next page.
+
+If `ps-zebra-stripe-follow' is nil, zebra stripe is restarted on each page.
+If `ps-zebra-stripe-follow' is non-nil, zebra stripe continues on next page.
+
+Visually, we have:
+
+ `ps-zebra-stripe-follow' `ps-zebra-stripe-follow'
+ is nil is non-nil
+ Current Page ------------------------ ------------------------
+ 1 XXXXXXXXXXXXXXXXXXXXX 1 XXXXXXXXXXXXXXXXXXXXX
+ 2 XXXXXXXXXXXXXXXXXXXXX 2 XXXXXXXXXXXXXXXXXXXXX
+ 3 XXXXXXXXXXXXXXXXXXXXX 3 XXXXXXXXXXXXXXXXXXXXX
+ 4 4
+ 5 5
+ 6 6
+ 7 XXXXXXXXXXXXXXXXXXXXX 7 XXXXXXXXXXXXXXXXXXXXX
+ 8 XXXXXXXXXXXXXXXXXXXXX 8 XXXXXXXXXXXXXXXXXXXXX
+ ------------------------ ------------------------
+ Next Page ------------------------ ------------------------
+ 9 XXXXXXXXXXXXXXXXXXXXX 9 XXXXXXXXXXXXXXXXXXXXX
+ 10 XXXXXXXXXXXXXXXXXXXXX 10
+ 11 XXXXXXXXXXXXXXXXXXXXX 11
+ 12 12
+ 13 13 XXXXXXXXXXXXXXXXXXXXX
+ 14 14 XXXXXXXXXXXXXXXXXXXXX
+ 15 XXXXXXXXXXXXXXXXXXXXX 15 XXXXXXXXXXXXXXXXXXXXX
+ 16 XXXXXXXXXXXXXXXXXXXXX 16
+ ------------------------ ------------------------"
+ :type 'boolean
:group 'ps-print-zebra)
(defcustom ps-line-number nil
"*Non-nil means print line number."
:type 'boolean
- :group 'ps-print)
+ :group 'ps-print-miscellany)
+
+(defcustom ps-line-number-step 1
+ "*Specify the interval that line number is printed.
+
+For example, `ps-line-number-step' is set to 2, the printing will look like:
+
+ 1 one line
+ one line
+ 3 one line
+ one line
+ 5 one line
+ one line
+ ...
+
+Valid values are:
+
+ integer an integer that specifies the interval that line number is
+ printed. If it's lesser than or equal to zero, it's used the
+ value 1.
+
+ `zebra' specifies that only the line number of the first line in a zebra
+ stripe is to be printed.
+
+Any other value is treated as `zebra'."
+ :type '(choice :menu-tag "Line Number Step"
+ :tag "Line Number Step"
+ (integer :tag "Step Interval")
+ (const :tag "Synchronize Zebra" zebra))
+ :group 'ps-print-miscellany)
+
+(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:
+
+ one line
+ one line
+ 3 one line
+ one line
+ one line
+ 6 one line
+ one line
+ one line
+ 9 one line
+ one line
+ ...
+
+The values for `ps-line-number-start':
+
+ * If `ps-line-number-step' is an integer, must be between 1 and the value
+ 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. Use this combination if you
+ wish that line number be relative to zebra stripes."
+ :type '(integer :tag "Start Step Interval")
+ :group 'ps-print-miscellany)
(defcustom ps-print-background-image nil
"*EPS image list to be printed on background.
For example, if you wish to print an EPS image on all pages do:
'((\"~/images/EPS-image.ps\"))"
- :type '(repeat (list (file :tag "EPS File")
- (choice :tag "X" number string (const nil))
- (choice :tag "Y" number string (const nil))
- (choice :tag "X Scale" number string (const nil))
- (choice :tag "Y Scale" number string (const nil))
- (choice :tag "Rotation" number string (const nil))
- (repeat :tag "Pages" :inline t
- (radio (integer :tag "Page")
- (cons :tag "Range"
- (integer :tag "From")
- (integer :tag "To"))))))
+ :type '(repeat
+ (list
+ (file :tag "EPS File")
+ (choice :tag "X" (const :tag "default" nil) number string)
+ (choice :tag "Y" (const :tag "default" nil) number string)
+ (choice :tag "X Scale" (const :tag "default" nil) number string)
+ (choice :tag "Y Scale" (const :tag "default" nil) number string)
+ (choice :tag "Rotation" (const :tag "default" nil) number string)
+ (repeat :tag "Pages" :inline t
+ (radio (integer :tag "Page")
+ (cons :tag "Range"
+ (integer :tag "From")
+ (integer :tag "To"))))))
:group 'ps-print-background)
(defcustom ps-print-background-text nil
For example, if you wish to print text \"Preliminary\" on all pages do:
'((\"Preliminary\"))"
- :type '(repeat (list (string :tag "Text")
- (choice :tag "X" number string (const nil))
- (choice :tag "Y" number string (const nil))
- (choice :tag "Font" string (const nil))
- (choice :tag "Fontsize" number string (const nil))
- (choice :tag "Gray" number string (const nil))
- (choice :tag "Rotation" number string (const nil))
- (repeat :tag "Pages" :inline t
- (radio (integer :tag "Page")
- (cons :tag "Range"
- (integer :tag "From")
- (integer :tag "To"))))))
+ :type '(repeat
+ (list
+ (string :tag "Text")
+ (choice :tag "X" (const :tag "default" nil) number string)
+ (choice :tag "Y" (const :tag "default" nil) number string)
+ (choice :tag "Font" (const :tag "default" nil) string)
+ (choice :tag "Fontsize" (const :tag "default" nil) number string)
+ (choice :tag "Gray" (const :tag "default" nil) number string)
+ (choice :tag "Rotation" (const :tag "default" nil) number string)
+ (repeat :tag "Pages" :inline t
+ (radio (integer :tag "Page")
+ (cons :tag "Range"
+ (integer :tag "From")
+ (integer :tag "To"))))))
:group 'ps-print-background)
;;; Horizontal layout
customizable by changing variables `ps-left-header' and
`ps-right-header'."
:type 'boolean
- :group 'ps-print-header)
+ :group 'ps-print-headers)
(defcustom ps-print-only-one-header nil
"*Non-nil means print only one header at the top of each page.
to have only one header over all columns or one header per column.
See also `ps-print-header'."
:type 'boolean
- :group 'ps-print-header)
+ :group 'ps-print-headers)
(defcustom ps-print-header-frame t
"*Non-nil means draw a gaudy frame around the header."
:type 'boolean
- :group 'ps-print-header)
+ :group 'ps-print-headers)
(defcustom ps-header-lines 2
"*Number of lines to display in page header, when generating PostScript."
:type 'integer
- :group 'ps-print-header)
+ :group 'ps-print-headers)
+
+(defcustom ps-switch-header 'duplex
+ "*Specify if headers are switched or not.
+
+Valid values are:
+
+nil Never switch headers.
+
+t Always switch headers.
+
+duplex Switch headers only when duplexing is on, that is, when
+ `ps-spool-duplex' is non-nil.
+
+Any other value is treated as t."
+ :type '(choice :menu-tag "Switch Header"
+ :tag "Switch Header"
+ (const :tag "Never Switch" nil)
+ (const :tag "Always Switch" t)
+ (const :tag "Switch When Duplexing" duplex))
+ :group 'ps-print-headers)
(defcustom ps-show-n-of-n t
"*Non-nil means show page numbers as N/M, meaning page N of M.
NOTE: page numbers are displayed as part of headers,
- see variable `ps-print-headers'."
+ see variable `ps-print-header'."
:type 'boolean
- :group 'ps-print-header)
+ :group 'ps-print-headers)
-(defcustom ps-spool-config (if (memq system-type
- '(win32 w32 mswindows ms-dos windows-nt))
- nil
- 'lpr-switches)
+(defcustom ps-spool-config
+ (if ps-windows-system
+ nil
+ 'lpr-switches)
"*Specify who is responsable for setting duplex and page size switches.
Valid values are:
So, if you need to use setpagedevice, set `ps-spool-config' to
`setpagedevice', generate a test file and send it to your printer; if
the printed file isn't ok, set `ps-spool-config' to nil."
- :type '(choice :tag "Spool Config"
+ :type '(choice :menu-tag "Spool Config"
+ :tag "Spool Config"
(const lpr-switches) (const setpagedevice)
- (other :tag "nil" nil))
- :group 'ps-print-header)
+ (const :tag "nil" nil))
+ :group 'ps-print-headers)
(defcustom ps-spool-duplex nil ; Not many people have duplex printers,
; so default to nil.
See also `ps-spool-tumble'."
:type 'boolean
- :group 'ps-print-header)
+ :group 'ps-print-headers)
(defcustom ps-spool-tumble nil
"*Specify how the page images on opposite sides of a sheet are oriented.
It has effect only when `ps-spool-duplex' is non-nil."
:type 'boolean
- :group 'ps-print-header)
+ :group 'ps-print-headers)
;;; Fonts
(defcustom ps-default-fg '(0.0 0.0 0.0)
"*RGB values of the default foreground color. Defaults to black."
- :type '(list (number :tag "Red") (number :tag "Green") (number :tag "Blue"))
+ :type '(choice :menu-tag "Default Foreground Gray/Color"
+ :tag "Default Foreground Gray/Color"
+ (number :tag "Gray Scale" :value 0.0)
+ (string :tag "Color Name" :value "black")
+ (list :tag "RGB Color" :value (0.0 0.0 0.0)
+ (number :tag "Red")
+ (number :tag "Green")
+ (number :tag "Blue")))
:group 'ps-print-color)
(defcustom ps-default-bg '(1.0 1.0 1.0)
"*RGB values of the default background color. Defaults to white."
- :type '(list (number :tag "Red") (number :tag "Green") (number :tag "Blue"))
+ :type '(choice :menu-tag "Default Background Gray/Color"
+ :tag "Default Background Gray/Color"
+ (number :tag "Gray Scale" :value 1.0)
+ (string :tag "Color Name" :value "white")
+ (list :tag "RGB Color" :value (1.0 1.0 1.0)
+ (number :tag "Red")
+ (number :tag "Green")
+ (number :tag "Blue")))
:group 'ps-print-color)
(defcustom ps-auto-font-detect t
:type '(repeat face)
:group 'ps-print-face)
+(defcustom ps-use-face-background nil
+ "*Specify if face background should be used.
+
+Valid values are:
+
+ t always use face background color.
+ nil never use face background color.
+ (face...) list of faces whose background color will be used.
+
+Any other value will be treated as t."
+ :type '(choice :menu-tag "Use Face Background"
+ :tag "Use Face Background"
+ (const :tag "Always Use Face Background" t)
+ (const :tag "Never Use Face Background" nil)
+ (repeat :menu-tag "Face Background List"
+ :tag "Face Background List"
+ face))
+ :group 'ps-print-face)
+
(defcustom ps-left-header
(list 'ps-get-buffer-name 'ps-header-dirpart)
"*The items to display (each on a line) on the left part of the page header.
In either case, function or variable, the string value has PostScript
string delimiters added to it."
:type '(repeat (choice string symbol))
- :group 'ps-print-header)
+ :group 'ps-print-headers)
(defcustom ps-right-header
(list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy 'time-stamp-hh:mm:ss)
See the variable `ps-left-header' for a description of the format of
this variable."
:type '(repeat (choice string symbol))
- :group 'ps-print-header)
+ :group 'ps-print-headers)
(defcustom ps-razzle-dazzle t
"*Non-nil means report progress while formatting buffer."
:type 'boolean
- :group 'ps-print)
+ :group 'ps-print-miscellany)
(defcustom ps-adobe-tag "%!PS-Adobe-3.0\n"
"*Contains the header line identifying the output as PostScript.
By default, `ps-adobe-tag' contains the standard identifier. Some
printers require slightly different versions of this line."
:type 'string
- :group 'ps-print)
+ :group 'ps-print-miscellany)
(defcustom ps-build-face-reference t
"*Non-nil means build the reference face lists.
"*Non-nil means the very first page is skipped.
It's like the very first character of buffer (or region) is ^L (\\014)."
:type 'boolean
- :group 'ps-print-header)
+ :group 'ps-print-headers)
-(defcustom ps-postscript-code-directory data-directory
+(defcustom ps-postscript-code-directory
+ (or (and (fboundp 'locate-data-directory) ; xemacs
+ (locate-data-directory "ps-print"))
+ data-directory) ; emacs
"*Directory where it's located the PostScript prologue file used by ps-print.
By default, this directory is the same as in the variable `data-directory'."
:type 'directory
- :group 'ps-print)
+ :group 'ps-print-miscellany)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
"Return the current PostScript-generation setup."
(format
"
+;;; ps-print version %s
\(setq ps-print-color-p %s
ps-lpr-command %S
ps-lpr-switches %s
ps-printer-name %S
ps-print-region-function %s
+ ps-manual-feed %S
ps-paper-type %s
+ ps-warn-paper-type %s
ps-landscape-mode %s
+ ps-print-upside-down %s
ps-number-of-columns %s
ps-zebra-stripes %s
ps-zebra-stripe-height %s
- ps-zebra-gray %s
+ ps-zebra-stripe-follow %S
+ ps-zebra-color %s
ps-line-number %s
+ ps-line-number-step %s
+ ps-line-number-start %S
+
+ ps-default-fg %s
+ ps-default-bg %s
+
+ ps-use-face-background %s
ps-print-control-characters %s
ps-print-header %s
ps-print-only-one-header %s
ps-print-header-frame %s
+ ps-switch-header %s
ps-header-lines %s
ps-show-n-of-n %s
ps-spool-config %s
ps-spool-tumble %s
ps-banner-page-when-duplexing %s
- ps-n-up-printing %s
- ps-n-up-margin %s
- ps-n-up-border-p %s
- ps-n-up-filling %s
+ ps-n-up-printing %s
+ ps-n-up-margin %s
+ ps-n-up-border-p %s
+ ps-n-up-filling %s
ps-multibyte-buffer %s
ps-font-family %s
ps-header-font-size %s
ps-header-title-font-size %s)
"
+ ps-print-version
ps-print-color-p
ps-lpr-command
(ps-print-quote ps-lpr-switches)
ps-printer-name
(ps-print-quote ps-print-region-function)
+ ps-manual-feed
(ps-print-quote ps-paper-type)
+ ps-warn-paper-type
ps-landscape-mode
+ ps-print-upside-down
ps-number-of-columns
ps-zebra-stripes
ps-zebra-stripe-height
- ps-zebra-gray
+ ps-zebra-stripe-follow
+ (ps-print-quote ps-zebra-color)
ps-line-number
+ (ps-print-quote ps-line-number-step)
+ ps-line-number-start
+ (ps-print-quote ps-default-fg)
+ (ps-print-quote ps-default-bg)
+ (ps-print-quote ps-use-face-background)
(ps-print-quote ps-print-control-characters)
(ps-print-quote ps-print-background-image)
(ps-print-quote ps-print-background-text)
ps-print-header
ps-print-only-one-header
ps-print-header-frame
+ (ps-print-quote ps-switch-header)
ps-header-lines
ps-show-n-of-n
(ps-print-quote ps-spool-config)
(defun ps-prologue-file (filenumber)
(save-excursion
- (let ((buffer
- (or (find-file-noselect
- (format "%sps-prin%d.ps"
- ps-postscript-code-directory filenumber)
- 'no-warn 'rawfile)
- (error "ps-print PostScript prologue %d file was not found."
- filenumber))))
+ (let* ((filename (format "%sps-prin%d.ps"
+ ps-postscript-code-directory filenumber))
+ (buffer
+ (or (find-file-noselect filename 'no-warn 'rawfile)
+ (error "ps-print PostScript prologue `%s' file was not found."
+ filename))))
(set-buffer buffer)
(prog1
(buffer-string)
(defvar ps-showline-count 1)
(defvar ps-control-or-escape-regexp nil)
+(defvar ps-n-up-on nil)
(defvar ps-background-pages nil)
(defvar ps-background-all-pages nil)
(defvar ps-background-image-count 0)
(defvar ps-current-font 0)
-(defvar ps-default-color (and ps-print-color-p ps-default-fg)) ; black
-(defvar ps-current-color ps-default-color)
+(defvar ps-default-foreground nil)
+(defvar ps-default-color nil)
+(defvar ps-current-color nil)
(defvar ps-current-bg nil)
(defvar ps-razchunk 0)
(defun ps-spool-without-faces (from to &optional region-p)
(run-hooks 'ps-print-hook)
- (ps-printing-region region-p)
+ (ps-printing-region region-p from)
(ps-generate (current-buffer) from to 'ps-generate-postscript))
(defun ps-spool-with-faces (from to &optional region-p)
(run-hooks 'ps-print-hook)
- (ps-printing-region region-p)
+ (ps-printing-region region-p from)
(ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces))
"Non-nil means ps-print is printing a region.")
-(defun ps-printing-region (region-p)
+(defun ps-printing-region (region-p from)
(setq ps-printing-region-p region-p
ps-printing-region
(cons (if region-p
- (ps-count-lines (point-min) (region-beginning))
+ (ps-count-lines (point-min) from)
1)
(ps-count-lines (point-min) (point-max)))))
ps-header-pad)
ps-print-height))))
-(defun ps-print-preprint (&optional filename)
- (and filename
- (or (numberp filename)
- (listp filename))
+(defun ps-print-preprint (prefix-arg)
+ (and prefix-arg
+ (or (numberp prefix-arg)
+ (listp prefix-arg))
(let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
(buffer-name)))
".ps"))
(defun ps-insert-file (fname)
(ps-flush-output)
- ;; Check to see that the file exists and is readable; if not, throw
- ;; an error.
- (or (file-readable-p fname)
- (error "Could not read file `%s'" fname))
(save-excursion
(set-buffer ps-spool-buffer)
(goto-char (point-max))
(ps-output "] def\n"))))
-(defun ps-output-boolean (name bool &optional no-def)
- (ps-output (format "/%s %s%s"
- name (if bool "true" "false") (if no-def "\n" " def\n"))))
+(defun ps-output-boolean (name bool)
+ (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
(defun ps-background-pages (page-list func)
"PrintHeight PrintPageWidth atan") ; rotation
(ps-float-format (nth 5 text) 0.85) ; gray
(ps-float-format (nth 1 text) "0") ; x position
- (ps-float-format (nth 2 text) "BottomMargin") ; y position
+ (ps-float-format (nth 2 text) "0") ; y position
"\nShowBackText} def\n")
(ps-background-pages (nthcdr 7 text) ; page list
(format "ShowBackText-%d\n"
(100 nil 10 10 0))
(letter
(1 nil 1 1 0)
+ (2 t 1 2 0) ; adjusted by PostScript code
(4 nil 2 2 0)
(6 t 2 3 0)
(9 nil 3 3 0)
(100 nil 10 10 0))
(letter-small
(1 nil 1 1 0)
+ (2 t 1 2 0) ; adjusted by PostScript code
(4 nil 2 2 0)
(6 t 2 3 0)
(9 nil 3 3 0)
(100 nil 10 10 0))
(executive
(1 nil 1 1 0)
+ (2 t 1 2 0) ; adjusted by PostScript code
(4 nil 2 2 0)
(6 t 2 3 0)
(9 nil 3 3 0)
(tumble (if ps-landscape-mode (not ps-spool-tumble) ps-spool-tumble))
(n-up (ps-n-up-printing))
(n-up-filling (ps-n-up-filling)))
- (and (> ps-n-up-printing 1) (setq tumble (not tumble)))
+ (and ps-n-up-on (setq tumble (not tumble)))
(ps-output
ps-adobe-tag
"%%Title: " (buffer-name) ; Take job name from name of
(format " %d" (round (ps-page-dimensions-get-height dimensions)))
" 0 () ()\n%%PageOrder: Ascend\n%%Pages: (atend)\n%%Requirements:"
(if ps-spool-duplex
- (format " duplex%s" (if tumble "(tumble)\n" "\n"))
+ (if tumble " duplex(tumble)\n" " duplex\n")
"\n"))
(ps-insert-string ps-print-prologue-header)
- (ps-output "%%EndComments\n\n%%BeginPrologue\n\n"
- "/gs_languagelevel /languagelevel where"
- "{pop languagelevel}{1}ifelse def\n"
- (format "/ErrorMessage %s def\n\n"
+ (ps-output "%%EndComments\n%%BeginDefaults\n%%PageMedia: "
+ (ps-page-dimensions-get-media dimensions)
+ "\n%%EndDefaults\n\n%%BeginPrologue\n\n"
+ "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n"
+ (format "/ErrorMessage %s def\n\n"
(or (cdr (assoc ps-error-handler-message
ps-error-handler-alist))
1)) ; send to paper
(ps-output "\n%%EndProcSet\n\n")
- (ps-output-boolean "SkipFirstPage " ps-banner-page-when-duplexing)
(ps-output-boolean "LandscapeMode "
(or ps-landscape-mode
(eq (ps-n-up-landscape n-up) 'pag)))
+ (ps-output-boolean "UpsideDown " ps-print-upside-down)
(ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns)
(format "/LandscapePageHeight %s def\n" ps-landscape-page-height)
(ps-output-boolean "PrintHeader " ps-print-header)
(ps-output-boolean "PrintOnlyOneHeader" ps-print-only-one-header)
(ps-output-boolean "PrintHeaderFrame " ps-print-header-frame)
+ (ps-output-boolean "SwitchHeader " (if (eq ps-switch-header 'duplex)
+ 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)
(* line-height 0.45))
line-height)))))
+ (ps-output-boolean "WarnPaperSize " ps-warn-paper-type)
(ps-output-boolean "Zebra " ps-zebra-stripes)
+ (ps-output-boolean "ZebraFollow " ps-zebra-stripe-follow)
(ps-output-boolean "PrintLineNumber " ps-line-number)
- (ps-output (format "/ZebraHeight %d def\n" ps-zebra-stripe-height)
- (format "/ZebraGray %s def\n" ps-zebra-gray)
- "/UseSetpagedevice "
+ (ps-output-boolean "SyncLineZebra " (not (integerp ps-line-number-step)))
+ (ps-output (format "/PrintLineStep %d def\n"
+ (if (integerp ps-line-number-step)
+ ps-line-number-step
+ ps-zebra-stripe-height))
+ (format "/PrintLineStart %d def\n" ps-line-number-start)
+ (format "/ZebraHeight %d def\n" ps-zebra-stripe-height)
+ "/ZebraColor "
+ (ps-format-color ps-zebra-color 0.95)
+ "def\n/BackgroundColor "
+ (ps-format-color ps-default-bg 1.0)
+ "def\n/UseSetpagedevice "
(if (eq ps-spool-config 'setpagedevice)
- "/setpagedevice where {pop true}{false}ifelse def\n"
- "false def\n")
- "\n/PageWidth "
+ "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
+ "false")
+ " def\n\n/PageWidth "
"PrintPageWidth LeftMargin add RightMargin add def\n\n"
(format "/N-Up %d def\n" ps-n-up-printing))
(ps-output-boolean "N-Up-Landscape" (eq (ps-n-up-landscape n-up) t))
(ps-output (format "/N-Up-Lines %d def\n" (ps-n-up-lines n-up))
(format "/N-Up-Columns %d def\n" (ps-n-up-columns n-up))
(format "/N-Up-Missing %d def\n" (ps-n-up-missing n-up))
- (format "/N-Up-Margin %s" ps-n-up-margin)
- " def\n/N-Up-Repeat "
+ (format "/N-Up-Margin %s def\n" ps-n-up-margin)
+ "/N-Up-Repeat "
(if ps-landscape-mode
(ps-n-up-end n-up-filling)
(ps-n-up-repeat n-up-filling))
"\n\n"
ps-print-duplex-feature
"\n%%EndFeature\n")))
- (ps-output "\n/Lines 0 def\n/PageCount 0 def\n\nBeginDoc\n%%EndSetup\n"))
+ (ps-output "\n%%BeginFeature: *ManualFeed "
+ (ps-boolean-capitalized ps-manual-feed)
+ "\nBMark /ManualFeed "
+ (ps-boolean-constant ps-manual-feed)
+ " EMark setpagedevice\n%%EndFeature\n"
+ "\n/Lines 0 def\n/PageCount 0 def\n\nBeginDoc\n%%EndSetup\n")
+ (and ps-banner-page-when-duplexing
+ (ps-output "\n%%Page: banner 0\nsave showpage restore\n")))
+
+
+(defun ps-format-color (color &optional default)
+ (let ((the-color (if (stringp color)
+ (ps-color-scale color)
+ color)))
+ (if (and the-color (listp the-color))
+ (concat "["
+ (format ps-color-format
+ (nth 0 the-color)
+ (nth 1 the-color)
+ (nth 2 the-color))
+ "] ")
+ (ps-float-format (if (numberp the-color) the-color default)))))
(defun ps-insert-string (prologue)
(if bool "True" "False"))
+(defun ps-boolean-constant (bool)
+ (if bool "true" "false"))
+
+
(defun ps-header-dirpart ()
(let ((fname (buffer-file-name)))
(if fname
(defun ps-begin-job ()
+ (let ((last-char (aref ps-postscript-code-directory
+ (1- (length ps-postscript-code-directory)))))
+ (or (eq last-char ?/)
+ (and ps-windows-system (eq last-char ?\\))
+ (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))
+ (or (listp ps-use-face-background)
+ (setq ps-use-face-background t))
+ (and (integerp ps-line-number-step)
+ (<= ps-line-number-step 0)
+ (setq ps-line-number-step 1))
+ (setq ps-n-up-on (> ps-n-up-printing 1)
+ ps-line-number-start (max 1 (min ps-line-number-start
+ (if (integerp ps-line-number-step)
+ ps-line-number-step
+ ps-zebra-stripe-height))))
(save-excursion
(set-buffer ps-spool-buffer)
(goto-char (point-max))
(string-as-unibyte "[\000-\037\177-\237]"))
((eq ps-print-control-characters 'control)
"[\000-\037\177]")
- (t "[\t\n\f]"))))
+ (t "[\t\n\f]"))
+ ps-default-foreground (ps-rgb-color ps-default-fg 0.0)
+ ps-default-color (and ps-print-color-p ps-default-foreground)
+ ps-current-color ps-default-color
+ ;; Set the color scale. We do it here instead of in the defvar so
+ ;; that ps-print can be dumped into emacs. This expression can't be
+ ;; evaluated at dump-time because X isn't initialized.
+ ps-color-p (and ps-print-color-p (ps-color-device))
+ ps-print-color-scale (if ps-color-p
+ (float (car (ps-color-values "white")))
+ 1.0)))
+
+
+(defun ps-rgb-color (color default)
+ (cond ((and color (listp color)) color)
+ ((stringp color) (ps-color-scale color))
+ ((numberp color) (list color color color))
+ (t (list default default default))
+ ))
+
(defmacro ps-page-number ()
`(1+ (/ (1- ps-page-count) ps-number-of-columns)))
-(defun ps-end-file ()
+(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
(ps-dummy-page))
;; Set end of PostScript file
(ps-output "EndSheet\n\n%%Trailer\n%%Pages: "
- (format "%d" ps-page-order)
+ (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"))
ps-page-order (1+ ps-page-order))
(and (> ps-page-order 1)
(ps-output "EndSheet\n"))
- (ps-output (format "\n%%%%Page: %d %d\n"
- ps-page-postscript ps-page-order))
- (ps-output (format "%d BeginSheet\nBeginDSCPage\n" ps-n-up-printing)))
+ (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)))
(defsubst ps-header-page ()
(ps-output "false BG\n")))
(defun ps-set-color (color)
- (setq ps-current-color (or color ps-default-fg))
+ (setq ps-current-color (or color ps-default-foreground))
(ps-output (format ps-color-format
(nth 0 ps-current-color)
(nth 1 ps-current-color) (nth 2 ps-current-color))
(ps-output-string str)
(ps-output " S\n")))
-(defun ps-color-value (x-color-value)
+(defun ps-color-scale (color)
;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
- (/ x-color-value ps-print-color-scale))
+ (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
; lucid
(t ; epoch
(defun ps-color-values (x-color)
- (cond ((fboundp 'x-color-values)
- (x-color-values x-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
- (if (color-specifier-p x-color)
- (color-name x-color)
- x-color)))))
- (t
- (error "No available function to determine X color values."))))
+ (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.")))))
))
new-face))))
+(defun ps-face-background (face background)
+ (and (or (eq ps-use-face-background t)
+ (cond ((symbolp face)
+ (memq face ps-use-face-background))
+ ((listp face)
+ (let (ok)
+ (while face
+ (if (memq (car face) ps-use-face-background)
+ (setq face nil
+ ok t)
+ (setq face (cdr face))))
+ ok))
+ (t
+ nil)
+ ))
+ background))
+
+
(defun ps-face-attribute-list (face-or-list)
(if (listp face-or-list)
;; list of faces
(let ((effects 0)
- foreground background face-attr)
+ foreground background face-attr face)
(while face-or-list
- (setq face-attr (ps-face-attributes (car face-or-list))
- effects (logior effects (aref face-attr 0)))
+ (setq face (car face-or-list)
+ face-or-list (cdr face-or-list)
+ face-attr (ps-face-attributes face)
+ effects (logior effects (aref face-attr 0)))
(or foreground (setq foreground (aref face-attr 1)))
- (or background (setq background (aref face-attr 2)))
- (setq face-or-list (cdr face-or-list)))
+ (or background
+ (setq background (ps-face-background face (aref face-attr 2)))))
(vector effects foreground background))
;; simple face
(ps-face-attributes face-or-list)))
(let* ((face-bit (ps-face-attribute-list face))
(effect (aref face-bit 0))
(foreground (aref face-bit 1))
- (background (aref face-bit 2))
+ (background (ps-face-background face (aref face-bit 2)))
(fg-color (if (and ps-color-p foreground)
- (mapcar 'ps-color-value
- (ps-color-values foreground))
+ (ps-color-scale foreground)
ps-default-color))
(bg-color (and ps-color-p background
- (mapcar 'ps-color-value
- (ps-color-values background)))))
+ (ps-color-scale background))))
(ps-plot-region
from to
(ps-font-number 'ps-font-for-text
(goto-char to))
-(defun ps-xemacs-face-kind-p (face kind kind-regex kind-list)
+(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
(font-instance-properties frame-font))))
(kind-spec (cdr-safe kind-cons))
(case-fold-search t))
- (or (and kind-spec (string-match kind-regex kind-spec))
- ;; Kludge-compatible:
- (memq face kind-list))))
+ (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)))
; 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)
- (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold"
- ps-bold-faces))
+ (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-italic-faces)
- (ps-xemacs-face-kind-p face 'SLANT "i\\|o" ps-italic-faces)))
+ (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
))
(vector (logior (if (ps-face-bold-p face) 1 0) ; bold
(if (ps-face-italic-p face) 2 0) ; italic
(if (ps-face-underlined-p face) 4 0)) ; underline
- (face-foreground face)
- (face-background face))))
+ (ps-face-foreground-name face)
+ (ps-face-background-name face))))
(cond ((not (eq ps-print-emacs-type 'emacs))
(setq ps-current-effect 0)
;; Build the reference lists of faces if necessary.
- (if (or ps-always-build-face-reference
- ps-build-face-reference)
- (progn
- (message "Collecting face information...")
- (ps-build-reference-face-lists)))
- ;; Set the color scale. We do it here instead of in the defvar so
- ;; that ps-print can be dumped into emacs. This expression can't be
- ;; evaluated at dump-time because X isn't initialized.
- (setq ps-color-p (and ps-print-color-p (ps-color-device))
- ps-print-color-scale (if ps-color-p
- (float (car (ps-color-values "white")))
- 1.0))
+ (when (or ps-always-build-face-reference
+ ps-build-face-reference)
+ (message "Collecting face information...")
+ (ps-build-reference-face-lists))
;; Generate some PostScript.
(save-restriction
(narrow-to-region from to)
(let ((face 'default)
(position to))
(cond
- ((or (eq ps-print-emacs-type 'lucid)
- (eq ps-print-emacs-type 'xemacs))
+ ((memq ps-print-emacs-type '(xemacs lucid))
;; Build the list of extents...
(let ((a (cons 'dummy nil))
record type extent extent-list)
(funcall genfunc from to)
(ps-end-page)
- (ps-end-file)
+ (ps-end-file needs-begin-file)
(ps-end-job)
;; Setting this variable tells the unwind form that the
total-lines total-pages) t))))
+(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))
printer-name)))
(ps-lpr-switches
(append (and (stringp ps-printer-name)
- (list (concat "-P" ps-printer-name)))
+ (list (concat ps-printer-name-option
+ ps-printer-name)))
ps-lpr-switches)))
(apply (or ps-print-region-function 'call-process-region)
(point-min) (point-max) ps-lpr-command nil
(save-excursion
(goto-char (point-min))
(if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
- (buffer-substring-no-properties (match-beginning 1) (match-end 1))
+ (buffer-substring (match-beginning 1) (match-end 1))
"Subject ???")))
;; Look in an article or mail message for the From: line. Sorta-kinda
(save-excursion
(goto-char (point-min))
(if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
- (let ((fromstring (buffer-substring-no-properties (match-beginning 1)
- (match-end 1))))
+ (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
(cond
;; Try first to match addresses that look like
(substring fromstring (match-beginning 1) (match-end 1)))
;; Next try to match addresses that look like
- ;; Jim Thompson <thompson@wg2.waii.com>
- ((string-match "\\(.*\\)[ \t]+<.*>" fromstring)
- (substring fromstring (match-beginning 1) (match-end 1)))
+ ;; Jim Thompson <thompson@wg2.waii.com> or
+ ;; "Jim Thompson" <thompson@wg2.waii.com>
+ ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)
+ (substring fromstring (match-beginning 2) (match-end 2)))
;; Couldn't find a real name -- show the address instead.
(t fromstring)))
(save-excursion
(goto-char (point-min))
(if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
- (buffer-substring-no-properties (match-beginning 1) (match-end 1))
+ (buffer-substring (match-beginning 1) (match-end 1))
"File ???")))
;; Look in an article or mail message for the Subject: line. To be
(save-excursion
(goto-char (point-min))
(if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
- (buffer-substring-no-properties (match-beginning 1) (match-end 1))
+ (buffer-substring (match-beginning 1) (match-end 1))
"Node ???")))
(defun ps-info-mode-hook ()