Mercurial > emacs
changeset 47426:ec3123180ac5
Adjust ps-print-color-p, ps-default-fg and ps-default-bg setting.
(ps-print-version): New version number (6.5.7).
(ps-mark-active-p): New fun.
(ps-print-preprint-region): Adjust code.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 12 Sep 2002 03:21:57 +0000 |
parents | 525668986222 |
children | 8cdcbab66042 |
files | lisp/ps-print.el |
diffstat | 1 files changed, 43 insertions(+), 38 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ps-print.el Thu Sep 12 03:21:21 2002 +0000 +++ b/lisp/ps-print.el Thu Sep 12 03:21:57 2002 +0000 @@ -10,12 +10,12 @@ ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) ;; Vinicius Jose Latorre <vinicius@cpqd.com.br> ;; Keywords: wp, print, PostScript -;; Time-stamp: <2002/09/06 20:11:00 vinicius> -;; Version: 6.5.6 +;; Time-stamp: <2002/09/11 15:52:39 vinicius> +;; Version: 6.5.7 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ -(defconst ps-print-version "6.5.6" - "ps-print.el, v 6.5.6 <2002/09/06 vinicius> +(defconst ps-print-version "6.5.7" + "ps-print.el, v 6.5.7 <2002/09/11 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 @@ -1514,7 +1514,32 @@ (cond ((string-match "XEmacs" emacs-version) 'xemacs) ((string-match "Lucid" emacs-version) 'lucid) ((string-match "Epoch" emacs-version) 'epoch) - (t 'emacs)))) + (t 'emacs))) + + (or (memq ps-print-emacs-type '(lucid xemacs)) + (require 'faces)) ; face-font, face-underline-p, + ; x-font-regexp + + (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, lucid, epoch + (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))) + ))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2866,9 +2891,7 @@ ;; 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. @@ -2890,7 +2913,8 @@ (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" @@ -2902,7 +2926,8 @@ (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" @@ -3617,13 +3642,11 @@ (eval-and-compile - (if (memq ps-print-emacs-type '(lucid xemacs)) - ;; XEmacs change: Need to check for emacs-major-version too. - (if (or (< emacs-major-version 19) - (and (= emacs-major-version 19) (< emacs-minor-version 12))) - (setq ps-print-color-p nil)) - (require 'faces)) ; face-font, face-underline-p, - ; x-font-regexp + (and (memq ps-print-emacs-type '(lucid 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) @@ -3664,11 +3687,6 @@ (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) @@ -3680,9 +3698,6 @@ (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))) @@ -3691,9 +3706,8 @@ (or (ps-e-face-italic-p face) (memq face ps-italic-faces))) ) - ; xemacs - ; lucid - (t ; epoch + + (t ; xemacs, lucid, epoch ;; to avoid XEmacs compilation gripes (defvar coding-system-for-write nil) @@ -3718,12 +3732,6 @@ (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 @@ -4430,10 +4438,7 @@ (defun ps-print-preprint-region (prefix-arg) - (or (and (fboundp 'mark-active) - (mark-active)) - (and (fboundp 'region-active-p) - (region-active-p)) + (or (ps-mark-active-p) (error "The mark is not set now")) (list (point) (mark) (ps-print-preprint prefix-arg)))