Mercurial > emacs
changeset 37489:ba96560d3f9e
Color specified by number is forced to be float number.
(ps-print-version): New version number (6.5.1.1).
(ps-header-frame-alist, ps-footer-frame-alist): Adjust color
initialization.
(ps-prefix-quote): New internal var.
(ps-print-quote): New fun.
(ps-setup, ps-output-frame-properties, ps-float-format)
(ps-format-color): Code fix.
(ps-plot-region): Eliminate redundant foreground color text
setting.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Thu, 26 Apr 2001 09:29:18 +0000 |
parents | a795d663002c |
children | c0c12ef6e869 |
files | lisp/ps-print.el |
diffstat | 1 files changed, 70 insertions(+), 63 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ps-print.el Thu Apr 26 07:40:14 2001 +0000 +++ b/lisp/ps-print.el Thu Apr 26 09:29:18 2001 +0000 @@ -10,12 +10,12 @@ ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> ;; Keywords: wp, print, PostScript -;; Time-stamp: <2001/04/07 13:41:03 Vinicius> -;; Version: 6.5.1 +;; Time-stamp: <2001/04/24 15:31:37 vinicius> +;; Version: 6.5.1.1 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ -(defconst ps-print-version "6.5.1" - "ps-print.el, v 6.5.1 <2001/04/07 vinicius> +(defconst ps-print-version "6.5.1.1" + "ps-print.el, v 6.5.1.1 <2001/04/24 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 @@ -2338,11 +2338,11 @@ :group 'ps-print-headers) (defcustom ps-header-frame-alist - '((fore-color . 0) + '((fore-color . 0.0) (back-color . 0.9) (border-width . 0.4) - (border-color . 0) - (shadow-color . 0)) + (border-color . 0.0) + (shadow-color . 0.0)) "*Specify header frame properties alist. Valid frame properties are: @@ -2375,9 +2375,9 @@ (const :format "" fore-color) (choice :menu-tag "Foreground Color" :tag "Foreground Color" - (number :tag "Gray Scale" :value 0) + (number :tag "Gray Scale" :value 0.0) (string :tag "Color Name" :value "black") - (list :tag "RGB Color" :value (0 0 0) + (list :tag "RGB Color" :value (0.0 0.0 0.0) (number :tag "Red") (number :tag "Green") (number :tag "Blue")))) @@ -2398,9 +2398,9 @@ (const :format "" border-color) (choice :menu-tag "Border Color" :tag "Border Color" - (number :tag "Gray Scale" :value 0) + (number :tag "Gray Scale" :value 0.0) (string :tag "Color Name" :value "black") - (list :tag "RGB Color" :value (0 0 0) + (list :tag "RGB Color" :value (0.0 0.0 0.0) (number :tag "Red") (number :tag "Green") (number :tag "Blue")))) @@ -2408,9 +2408,9 @@ (const :format "" shadow-color) (choice :menu-tag "Shadow Color" :tag "Shadow Color" - (number :tag "Gray Scale" :value 0) + (number :tag "Gray Scale" :value 0.0) (string :tag "Color Name" :value "black") - (list :tag "RGB Color" :value (0 0 0) + (list :tag "RGB Color" :value (0.0 0.0 0.0) (number :tag "Red") (number :tag "Green") (number :tag "Blue")))))) @@ -2437,11 +2437,11 @@ :group 'ps-print-headers) (defcustom ps-footer-frame-alist - '((fore-color . 0) + '((fore-color . 0.0) (back-color . 0.9) (border-width . 0.4) - (border-color . 0) - (shadow-color . 0)) + (border-color . 0.0) + (shadow-color . 0.0)) "*Specify footer frame properties alist. Don't change this alist directly, instead use customization, or `ps-value', @@ -2456,9 +2456,9 @@ (const :format "" fore-color) (choice :menu-tag "Foreground Color" :tag "Foreground Color" - (number :tag "Gray Scale" :value 0) + (number :tag "Gray Scale" :value 0.0) (string :tag "Color Name" :value "black") - (list :tag "RGB Color" :value (0 0 0) + (list :tag "RGB Color" :value (0.0 0.0 0.0) (number :tag "Red") (number :tag "Green") (number :tag "Blue")))) @@ -2479,9 +2479,9 @@ (const :format "" border-color) (choice :menu-tag "Border Color" :tag "Border Color" - (number :tag "Gray Scale" :value 0) + (number :tag "Gray Scale" :value 0.0) (string :tag "Color Name" :value "black") - (list :tag "RGB Color" :value (0 0 0) + (list :tag "RGB Color" :value (0.0 0.0 0.0) (number :tag "Red") (number :tag "Green") (number :tag "Blue")))) @@ -2489,9 +2489,9 @@ (const :format "" shadow-color) (choice :menu-tag "Shadow Color" :tag "Shadow Color" - (number :tag "Gray Scale" :value 0) + (number :tag "Gray Scale" :value 0.0) (string :tag "Color Name" :value "black") - (list :tag "RGB Color" :value (0 0 0) + (list :tag "RGB Color" :value (0.0 0.0 0.0) (number :tag "Red") (number :tag "Green") (number :tag "Blue")))))) @@ -3274,34 +3274,14 @@ (interactive (list (count-lines (mark) (point)))) (ps-nb-pages nb-lines)) +(defvar ps-prefix-quote nil) + ;;;###autoload (defun ps-setup () "Return the current PostScript-generation setup." - (let (prefix) + (let (ps-prefix-quote) (mapconcat - #'(lambda (elt) - (cond - ((null elt) "") - ((stringp elt) elt) - (t - (let* ((col (car elt)) - (sym (cdr elt)) - (key (symbol-name sym)) - (len (length key)) - (val (symbol-value sym))) - (concat (if prefix - prefix - (setq prefix " ") - "(setq ") - key - (if (> col len) - (make-string (- col len) ?\ ) - " ") - (cond ((null val) "nil") - ((eq val t) "t") - ((or (symbolp val) (listp val)) (format "'%S" val)) - (t (format "%S" val)))))) - )) + #'ps-print-quote (list (concat "\n;;; ps-print version " ps-print-version "\n") '(25 . ps-print-color-p) @@ -3420,6 +3400,31 @@ ;; Utility functions and variables: +(defun ps-print-quote (elt) + (cond + ((null elt) "") + ((stringp elt) elt) + (t + (let* ((col (car elt)) + (sym (cdr elt)) + (key (symbol-name sym)) + (len (length key)) + (val (symbol-value sym))) + (concat (if ps-prefix-quote + ps-prefix-quote + (setq ps-prefix-quote " ") + "(setq ") + key + (if (> col len) + (make-string (- col len) ?\ ) + " ") + (cond ((null val) "nil") + ((eq val t) "t") + ((or (symbolp val) (listp val)) (format "'%S" val)) + (t (format "%S" val)))))) + )) + + (defun ps-value (alist-sym key) "Return value from association list ALIST-SYM which car is `eq' to KEY." (cdr (assq key (symbol-value alist-sym)))) @@ -4455,11 +4460,11 @@ (defun ps-output-frame-properties (name alist) (ps-output "/" name " [" - (ps-format-color (cdr (assq 'fore-color alist)) 0) + (ps-format-color (cdr (assq 'fore-color alist)) 0.0) (ps-format-color (cdr (assq 'back-color alist)) 0.9) (ps-float-format (or (cdr (assq 'border-width alist)) 0.4)) - (ps-format-color (cdr (assq 'border-color alist)) 0) - (ps-format-color (cdr (assq 'shadow-color alist)) 0) + (ps-format-color (cdr (assq 'border-color alist)) 0.0) + (ps-format-color (cdr (assq 'shadow-color alist)) 0.0) "]def\n")) @@ -4507,12 +4512,13 @@ (defun ps-float-format (value &optional default) (let ((literal (or value default))) - (if literal - (format (if (numberp literal) - ps-float-format - "%s ") - literal) - " "))) + (cond ((null literal) + " ") + ((numberp literal) + (format ps-float-format (* literal 1.0))) ; force float number + (t + (format "%s " literal)) + ))) (defun ps-background-text () @@ -5297,9 +5303,9 @@ (if (and the-color (listp the-color)) (concat "[" (format ps-color-format - (nth 0 the-color) - (nth 1 the-color) - (nth 2 the-color)) + (* (nth 0 the-color) 1.0) ; force float number + (* (nth 1 the-color) 1.0) ; force float number + (* (nth 2 the-color) 1.0)) ; force float number "] ") (ps-float-format (if (numberp the-color) the-color default))))) @@ -5644,15 +5650,16 @@ (defun ps-plot-region (from to font &optional fg-color bg-color effects) - (if (not (equal font ps-current-font)) + (or (equal font ps-current-font) (ps-set-font font)) ;; Specify a foreground color only if one's specified and it's ;; different than the current. - (if (not (equal fg-color ps-current-color)) - (ps-set-color fg-color)) - - (if (not (equal bg-color ps-current-bg)) + (let ((fg (or fg-color ps-default-foreground))) + (or (equal fg ps-current-color) + (ps-set-color fg))) + + (or (equal bg-color ps-current-bg) (ps-set-bg bg-color)) ;; Specify effects (underline, overline, box, etc)