;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
;; Vinicius Jose Latorre <vinicius@cpqd.com.br>
;; Keywords: wp, print, PostScript
-;; Time-stamp: <2001/09/17 14:50:19 vinicius>
-;; Version: 6.5.5
+;; Time-stamp: <2002/09/13 10:10:20 vinicius>
+;; Version: 6.5.8
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
-(defconst ps-print-version "6.5.5"
- "ps-print.el, v 6.5.5 <2001/09/17 vinicius>
+(defconst ps-print-version "6.5.8"
+ "ps-print.el, v 6.5.8 <2002/09/13 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
;;
;; This package provides printing of Emacs buffers on PostScript printers; the
;; buffer's bold and italic text attributes are preserved in the printer
-;; output. ps-print is intended for use with Emacs or Lucid Emacs, together
-;; with a fontifying package such as font-lock or hilit.
+;; output. ps-print is intended for use with Emacs or XEmacs, together with a
+;; fontifying package such as font-lock or hilit.
;;
;; ps-print uses the same face attributes defined through font-lock or hilit to
;; print a PostScript file, but some faces are better seeing on the screen than
;;
;; Faces are always treated as opaque.
;;
-;; Epoch and Emacs 19 not supported. At all.
+;; Epoch, Lucid and Emacs 19 not supported. At all.
;;
;; Fixed-pitch fonts work better for line folding, but are not required.
;;
(error "`ps-print' requires floating point support"))
+ (defvar ps-print-emacs-type
+ (let ((case-fold-search t))
+ (cond ((string-match "XEmacs" emacs-version) 'xemacs)
+ ((string-match "Lucid" emacs-version)
+ (error "`ps-print' doesn't support Lucid"))
+ ((string-match "Epoch" emacs-version)
+ (error "`ps-print' doesn't support Epoch"))
+ (t
+ (unless (and (boundp 'emacs-major-version)
+ (> emacs-major-version 19))
+ (error "`ps-print' only supports Emacs 20 and higher"))
+ 'emacs))))
+
+
;; For Emacs 20.2 and the earlier version.
(or (fboundp 'set-buffer-multibyte)
(defconst ps-windows-system
(memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
(defconst ps-lp-system
- (memq system-type '(usg-unix-v dgux hpux irix))))
+ (memq system-type '(usg-unix-v dgux hpux irix)))
+
+
+ (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
+ (defvar mark-active nil)
+ (defun ps-mark-active-p ()
+ mark-active)
+ (defalias 'ps-face-foreground-name 'face-foreground)
+ (defalias 'ps-face-background-name 'face-background)
+ )
+ (t ; xemacs
+ (defalias 'ps-mark-active-p 'region-active-p)
+ (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)))
+ )))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
For any other printing utility, see its documentation.
-Set this to \"\" or nil, if the utility given by `ps-lpr-command' needs an empty
-printer name option.
+Set this to \"\" or nil, if the utility given by `ps-lpr-command'
+needs an empty printer name option--that is, pass the printer name
+with no special option preceding it.
-Any other value is treated as nil, that is, an empty printer name option.
+Any value that is not a string is treated as nil.
This variable is used only when `ps-printer-name' is a non-empty string."
:type '(choice :menu-tag "Printer Name Option"
;; B4 10.125 inch x 14.33 inch
;; B5 7.16 inch x 10.125 inch
+;;;###autoload
(defcustom ps-page-dimensions-database
(list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4")
(list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3")
;;; Colors
;; Printing color requires x-color-values.
+;; XEmacs change: Need autoload for the "Options->Printing->Color Printing"
+;; widget to work.
+;;;###autoload
(defcustom ps-print-color-p
- (or (and (fboundp 'color-values) ; Emacs
- (ps-e-color-values "Green"))
- (fboundp 'x-color-values) ; Emacs
+ (or (fboundp 'x-color-values) ; Emacs
(fboundp 'color-instance-rgb-components))
; XEmacs
"*Specify how buffer's text color is printed.
(const :tag "Print Black/White Color" black-white))
:group 'ps-print-color)
-(defcustom ps-default-fg '(0.0 0.0 0.0)
+(defcustom ps-default-fg (or (ps-face-foreground-name 'default)
+ '(0.0 0.0 0.0)) ; black
"*RGB values of the default foreground color. Defaults to black."
:type '(choice :menu-tag "Default Foreground Gray/Color"
:tag "Default Foreground Gray/Color"
(number :tag "Blue")))
:group 'ps-print-color)
-(defcustom ps-default-bg '(1.0 1.0 1.0)
+(defcustom ps-default-bg (or (ps-face-background-name 'default)
+ '(1.0 1.0 1.0)) ; white
"*RGB values of the default background color. Defaults to white."
:type '(choice :menu-tag "Default Background Gray/Color"
:tag "Default Background Gray/Color"
:group 'ps-print-headers)
(defcustom ps-postscript-code-directory
- (or (and (fboundp 'locate-data-directory) ; xemacs
- (locate-data-directory "ps-print"))
- data-directory) ; emacs
+ (or (cond
+ ((eq ps-print-emacs-type 'emacs) ; emacs
+ data-directory)
+ ((fboundp 'locate-data-directory) ; xemacs
+ (locate-data-directory "ps-print"))
+ ((boundp 'data-directory) ; xemacs
+ data-directory)
+ (t ; don't know what to do
+ nil))
+ (error "`ps-postscript-code-directory' isn't set properly"))
"*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
If `ps-prefix-quote' is nil, it's set to t after generating string."
(cond
- ((null elt) "")
((stringp elt) elt)
- (t
+ ((and (consp elt) (integerp (car elt))
+ (symbolp (cdr elt)) (boundp (cdr elt)))
(let* ((col (car elt))
(sym (cdr elt))
(key (symbol-name sym))
((eq val t) "t")
((or (symbolp val) (listp val)) (format "'%S" val))
(t (format "%S" val))))))
+ (t "")
))
(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
+ (and (eq ps-print-emacs-type 'xemacs)
+ ;; XEmacs change: Need to check for emacs-major-version too.
+ (or (< emacs-major-version 19)
+ (and (= emacs-major-version 19) (< emacs-minor-version 12)))
+ (setq ps-print-color-p nil))
;; 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
+ ;; XEmacs change: Need to check for emacs-major-version too.
+ (or (> emacs-major-version 19)
+ (and (= emacs-major-version 19)
+ (>= emacs-minor-version 12)))) ; xemacs >= 19.12
(defun ps-color-device ()
(eq (ps-x-device-class) 'color)))
(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)
(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 (ps-e-face-bold-p face)
(memq face ps-bold-faces)))
(or (ps-e-face-italic-p face)
(memq face ps-italic-faces)))
)
- ; xemacs
- ; lucid
- (t ; epoch
+
+ (t ; xemacs
;; to avoid XEmacs compilation gripes
(defvar coding-system-for-write nil)
(t
(error "No available function to determine X color values")))))
- (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
;; PostScript output.
"%0.3f %0.3f %0.3f"
- ;; Lucid emacsen will have to make do with %s (princ) for floats.
+ ;; XEmacs will have to make do with %s (princ) for floats.
"%s %s %s"))
;; These values determine how much print-height to deduct when headers/footers
(defun ps-print-preprint-region (prefix-arg)
- (or mark-active
+ (or (ps-mark-active-p)
(error "The mark is not set now"))
(list (point) (mark) (ps-print-preprint prefix-arg)))
;; Emacs understands the %f format; we'll use it to limit color RGB values
;; to three decimals to cut down some on the size of the PostScript output.
-;; Lucid emacsen will have to make do with %s (princ) for floats.
+;; XEmacs will have to make do with %s (princ) for floats.
(defvar ps-float-format (if (eq ps-print-emacs-type 'emacs)
"%0.3f " ; emacs
- "%s ")) ; Lucid emacsen
+ "%s ")) ; xemacs
(defun ps-float-format (value &optional default)
(let ((face 'default)
(position to))
(cond
- ((memq ps-print-emacs-type '(xemacs lucid))
+ ((eq ps-print-emacs-type 'xemacs)
;; Build the list of extents...
(let ((a (cons 'dummy nil))
record type extent extent-list)