diff options
| author | Richard M. Stallman | 2002-09-12 03:21:57 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 2002-09-12 03:21:57 +0000 |
| commit | 509b4dbc0bf2921822e29c7650ecdf81630b327f (patch) | |
| tree | 5585fb80f0ac4a657d88ec7b632dd3725ca7b4af | |
| parent | 1b3f70a03ac7832ee8568dbb656ced3025b036f7 (diff) | |
| download | emacs-509b4dbc0bf2921822e29c7650ecdf81630b327f.tar.gz emacs-509b4dbc0bf2921822e29c7650ecdf81630b327f.zip | |
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.
| -rw-r--r-- | lisp/ps-print.el | 81 |
1 files changed, 43 insertions, 38 deletions
diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 54fbf2d6c85..4e6ef9b87e0 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el | |||
| @@ -10,12 +10,12 @@ | |||
| 10 | ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) | 10 | ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) |
| 11 | ;; Vinicius Jose Latorre <vinicius@cpqd.com.br> | 11 | ;; Vinicius Jose Latorre <vinicius@cpqd.com.br> |
| 12 | ;; Keywords: wp, print, PostScript | 12 | ;; Keywords: wp, print, PostScript |
| 13 | ;; Time-stamp: <2002/09/06 20:11:00 vinicius> | 13 | ;; Time-stamp: <2002/09/11 15:52:39 vinicius> |
| 14 | ;; Version: 6.5.6 | 14 | ;; Version: 6.5.7 |
| 15 | ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ | 15 | ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ |
| 16 | 16 | ||
| 17 | (defconst ps-print-version "6.5.6" | 17 | (defconst ps-print-version "6.5.7" |
| 18 | "ps-print.el, v 6.5.6 <2002/09/06 vinicius> | 18 | "ps-print.el, v 6.5.7 <2002/09/11 vinicius> |
| 19 | 19 | ||
| 20 | Vinicius's last change version -- this file may have been edited as part of | 20 | Vinicius's last change version -- this file may have been edited as part of |
| 21 | Emacs without changes to the version number. When reporting bugs, please also | 21 | Emacs without changes to the version number. When reporting bugs, please also |
| @@ -1514,7 +1514,32 @@ Please send all bug fixes and enhancements to | |||
| 1514 | (cond ((string-match "XEmacs" emacs-version) 'xemacs) | 1514 | (cond ((string-match "XEmacs" emacs-version) 'xemacs) |
| 1515 | ((string-match "Lucid" emacs-version) 'lucid) | 1515 | ((string-match "Lucid" emacs-version) 'lucid) |
| 1516 | ((string-match "Epoch" emacs-version) 'epoch) | 1516 | ((string-match "Epoch" emacs-version) 'epoch) |
| 1517 | (t 'emacs)))) | 1517 | (t 'emacs))) |
| 1518 | |||
| 1519 | (or (memq ps-print-emacs-type '(lucid xemacs)) | ||
| 1520 | (require 'faces)) ; face-font, face-underline-p, | ||
| 1521 | ; x-font-regexp | ||
| 1522 | |||
| 1523 | (defun ps-xemacs-color-name (color) | ||
| 1524 | (if (ps-x-color-specifier-p color) | ||
| 1525 | (ps-x-color-name color) | ||
| 1526 | color)) | ||
| 1527 | |||
| 1528 | |||
| 1529 | (cond ((eq ps-print-emacs-type 'emacs) ; emacs | ||
| 1530 | (defvar mark-active nil) | ||
| 1531 | (defun ps-mark-active-p () | ||
| 1532 | mark-active) | ||
| 1533 | (defalias 'ps-face-foreground-name 'face-foreground) | ||
| 1534 | (defalias 'ps-face-background-name 'face-background) | ||
| 1535 | ) | ||
| 1536 | (t ; xemacs, lucid, epoch | ||
| 1537 | (defalias 'ps-mark-active-p 'region-active-p) | ||
| 1538 | (defun ps-face-foreground-name (face) | ||
| 1539 | (ps-xemacs-color-name (face-foreground face))) | ||
| 1540 | (defun ps-face-background-name (face) | ||
| 1541 | (ps-xemacs-color-name (face-background face))) | ||
| 1542 | ))) | ||
| 1518 | 1543 | ||
| 1519 | 1544 | ||
| 1520 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 1545 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| @@ -2866,9 +2891,7 @@ uses the fonts resident in your printer." | |||
| 2866 | ;; widget to work. | 2891 | ;; widget to work. |
| 2867 | ;;;###autoload | 2892 | ;;;###autoload |
| 2868 | (defcustom ps-print-color-p | 2893 | (defcustom ps-print-color-p |
| 2869 | (or (and (fboundp 'color-values) ; Emacs | 2894 | (or (fboundp 'x-color-values) ; Emacs |
| 2870 | (ps-e-color-values "Green")) | ||
| 2871 | (fboundp 'x-color-values) ; Emacs | ||
| 2872 | (fboundp 'color-instance-rgb-components)) | 2895 | (fboundp 'color-instance-rgb-components)) |
| 2873 | ; XEmacs | 2896 | ; XEmacs |
| 2874 | "*Specify how buffer's text color is printed. | 2897 | "*Specify how buffer's text color is printed. |
| @@ -2890,7 +2913,8 @@ Any other value is treated as t." | |||
| 2890 | (const :tag "Print Black/White Color" black-white)) | 2913 | (const :tag "Print Black/White Color" black-white)) |
| 2891 | :group 'ps-print-color) | 2914 | :group 'ps-print-color) |
| 2892 | 2915 | ||
| 2893 | (defcustom ps-default-fg '(0.0 0.0 0.0) | 2916 | (defcustom ps-default-fg (or (ps-face-foreground-name 'default) |
| 2917 | '(0.0 0.0 0.0)) ; black | ||
| 2894 | "*RGB values of the default foreground color. Defaults to black." | 2918 | "*RGB values of the default foreground color. Defaults to black." |
| 2895 | :type '(choice :menu-tag "Default Foreground Gray/Color" | 2919 | :type '(choice :menu-tag "Default Foreground Gray/Color" |
| 2896 | :tag "Default Foreground Gray/Color" | 2920 | :tag "Default Foreground Gray/Color" |
| @@ -2902,7 +2926,8 @@ Any other value is treated as t." | |||
| 2902 | (number :tag "Blue"))) | 2926 | (number :tag "Blue"))) |
| 2903 | :group 'ps-print-color) | 2927 | :group 'ps-print-color) |
| 2904 | 2928 | ||
| 2905 | (defcustom ps-default-bg '(1.0 1.0 1.0) | 2929 | (defcustom ps-default-bg (or (ps-face-background-name 'default) |
| 2930 | '(1.0 1.0 1.0)) ; white | ||
| 2906 | "*RGB values of the default background color. Defaults to white." | 2931 | "*RGB values of the default background color. Defaults to white." |
| 2907 | :type '(choice :menu-tag "Default Background Gray/Color" | 2932 | :type '(choice :menu-tag "Default Background Gray/Color" |
| 2908 | :tag "Default Background Gray/Color" | 2933 | :tag "Default Background Gray/Color" |
| @@ -3617,13 +3642,11 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'." | |||
| 3617 | 3642 | ||
| 3618 | 3643 | ||
| 3619 | (eval-and-compile | 3644 | (eval-and-compile |
| 3620 | (if (memq ps-print-emacs-type '(lucid xemacs)) | 3645 | (and (memq ps-print-emacs-type '(lucid xemacs)) |
| 3621 | ;; XEmacs change: Need to check for emacs-major-version too. | 3646 | ;; XEmacs change: Need to check for emacs-major-version too. |
| 3622 | (if (or (< emacs-major-version 19) | 3647 | (or (< emacs-major-version 19) |
| 3623 | (and (= emacs-major-version 19) (< emacs-minor-version 12))) | 3648 | (and (= emacs-major-version 19) (< emacs-minor-version 12))) |
| 3624 | (setq ps-print-color-p nil)) | 3649 | (setq ps-print-color-p nil)) |
| 3625 | (require 'faces)) ; face-font, face-underline-p, | ||
| 3626 | ; x-font-regexp | ||
| 3627 | 3650 | ||
| 3628 | 3651 | ||
| 3629 | ;; Return t if the device (which can be changed during an emacs session) | 3652 | ;; Return t if the device (which can be changed during an emacs session) |
| @@ -3664,11 +3687,6 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'." | |||
| 3664 | (case-fold-search t)) | 3687 | (case-fold-search t)) |
| 3665 | (and kind-spec (string-match kind-regex kind-spec)))) | 3688 | (and kind-spec (string-match kind-regex kind-spec)))) |
| 3666 | 3689 | ||
| 3667 | (defun ps-xemacs-color-name (color) | ||
| 3668 | (if (ps-x-color-specifier-p color) | ||
| 3669 | (ps-x-color-name color) | ||
| 3670 | color)) | ||
| 3671 | |||
| 3672 | (cond ((eq ps-print-emacs-type 'emacs) ; emacs | 3690 | (cond ((eq ps-print-emacs-type 'emacs) ; emacs |
| 3673 | 3691 | ||
| 3674 | (defun ps-color-values (x-color) | 3692 | (defun ps-color-values (x-color) |
| @@ -3680,9 +3698,6 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'." | |||
| 3680 | (t | 3698 | (t |
| 3681 | (error "No available function to determine X color values")))) | 3699 | (error "No available function to determine X color values")))) |
| 3682 | 3700 | ||
| 3683 | (defalias 'ps-face-foreground-name 'face-foreground) | ||
| 3684 | (defalias 'ps-face-background-name 'face-background) | ||
| 3685 | |||
| 3686 | (defun ps-face-bold-p (face) | 3701 | (defun ps-face-bold-p (face) |
| 3687 | (or (ps-e-face-bold-p face) | 3702 | (or (ps-e-face-bold-p face) |
| 3688 | (memq face ps-bold-faces))) | 3703 | (memq face ps-bold-faces))) |
| @@ -3691,9 +3706,8 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'." | |||
| 3691 | (or (ps-e-face-italic-p face) | 3706 | (or (ps-e-face-italic-p face) |
| 3692 | (memq face ps-italic-faces))) | 3707 | (memq face ps-italic-faces))) |
| 3693 | ) | 3708 | ) |
| 3694 | ; xemacs | 3709 | |
| 3695 | ; lucid | 3710 | (t ; xemacs, lucid, epoch |
| 3696 | (t ; epoch | ||
| 3697 | 3711 | ||
| 3698 | ;; to avoid XEmacs compilation gripes | 3712 | ;; to avoid XEmacs compilation gripes |
| 3699 | (defvar coding-system-for-write nil) | 3713 | (defvar coding-system-for-write nil) |
| @@ -3718,12 +3732,6 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'." | |||
| 3718 | (t | 3732 | (t |
| 3719 | (error "No available function to determine X color values"))))) | 3733 | (error "No available function to determine X color values"))))) |
| 3720 | 3734 | ||
| 3721 | (defun ps-face-foreground-name (face) | ||
| 3722 | (ps-xemacs-color-name (face-foreground face))) | ||
| 3723 | |||
| 3724 | (defun ps-face-background-name (face) | ||
| 3725 | (ps-xemacs-color-name (face-background face))) | ||
| 3726 | |||
| 3727 | (defun ps-face-bold-p (face) | 3735 | (defun ps-face-bold-p (face) |
| 3728 | (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold") | 3736 | (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold") |
| 3729 | (memq face ps-bold-faces))) ; Kludge-compatible | 3737 | (memq face ps-bold-faces))) ; Kludge-compatible |
| @@ -4430,10 +4438,7 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th | |||
| 4430 | 4438 | ||
| 4431 | 4439 | ||
| 4432 | (defun ps-print-preprint-region (prefix-arg) | 4440 | (defun ps-print-preprint-region (prefix-arg) |
| 4433 | (or (and (fboundp 'mark-active) | 4441 | (or (ps-mark-active-p) |
| 4434 | (mark-active)) | ||
| 4435 | (and (fboundp 'region-active-p) | ||
| 4436 | (region-active-p)) | ||
| 4437 | (error "The mark is not set now")) | 4442 | (error "The mark is not set now")) |
| 4438 | (list (point) (mark) (ps-print-preprint prefix-arg))) | 4443 | (list (point) (mark) (ps-print-preprint prefix-arg))) |
| 4439 | 4444 | ||