mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-26 10:49:33 +00:00
Code Issues Releases Activity

Color specified by number is forced to be float number.

Browse Source 
(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.
This commit is contained in:
Gerd Moellmann 2001-04-26 09:30:00 +00:00
parent d3111e5aa9
commit efa89c1f70
2 changed files with 82 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
lisp/ChangeLog
View File

@ -1,3 +1,16 @@
2001-04-26 Vinicius Jose Latorre <vinicius@cpqd.com.br>
* ps-print.el: 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.
2001-04-26 Eli Zaretskii <eliz@is.elta.co.il> 2001-04-26 Eli Zaretskii <eliz@is.elta.co.il>
* dabbrev.el (dabbrev--select-buffers): Add a doc string. * dabbrev.el (dabbrev--select-buffers): Add a doc string.

131
lisp/ps-print.el
View File

@ -10,12 +10,12 @@
;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
;; Keywords: wp, print, PostScript ;; Keywords: wp, print, PostScript
;; Time-stamp: <2001/04/07 13:41:03 Vinicius> ;; Time-stamp: <2001/04/24 15:31:37 vinicius>
;; Version: 6.5.1 ;; Version: 6.5.1.1
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
(defconst ps-print-version "6.5.1" (defconst ps-print-version "6.5.1.1"
"ps-print.el, v 6.5.1 <2001/04/07 vinicius> "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 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 Emacs without changes to the version number. When reporting bugs, please also
@ -2338,11 +2338,11 @@ changing variables `ps-left-header' and `ps-right-header'."
:group 'ps-print-headers) :group 'ps-print-headers)
(defcustom ps-header-frame-alist (defcustom ps-header-frame-alist
'((fore-color . 0) '((fore-color . 0.0)
(back-color . 0.9) (back-color . 0.9)
(border-width . 0.4) (border-width . 0.4)
(border-color . 0) (border-color . 0.0)
(shadow-color . 0)) (shadow-color . 0.0))
"*Specify header frame properties alist. "*Specify header frame properties alist.
Valid frame properties are: Valid frame properties are:
@ -2375,9 +2375,9 @@ Don't change this alist directly, instead use customization, or `ps-value',
(const :format "" fore-color) (const :format "" fore-color)
(choice :menu-tag "Foreground Color" (choice :menu-tag "Foreground Color"
: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") (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 "Red")
(number :tag "Green") (number :tag "Green")
(number :tag "Blue")))) (number :tag "Blue"))))
@ -2398,9 +2398,9 @@ Don't change this alist directly, instead use customization, or `ps-value',
(const :format "" border-color) (const :format "" border-color)
(choice :menu-tag "Border Color" (choice :menu-tag "Border Color"
: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") (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 "Red")
(number :tag "Green") (number :tag "Green")
(number :tag "Blue")))) (number :tag "Blue"))))
@ -2408,9 +2408,9 @@ Don't change this alist directly, instead use customization, or `ps-value',
(const :format "" shadow-color) (const :format "" shadow-color)
(choice :menu-tag "Shadow Color" (choice :menu-tag "Shadow Color"
: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") (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 "Red")
(number :tag "Green") (number :tag "Green")
(number :tag "Blue")))))) (number :tag "Blue"))))))
@ -2437,11 +2437,11 @@ Footers are customizable by changing variables `ps-left-footer' and
:group 'ps-print-headers) :group 'ps-print-headers)
(defcustom ps-footer-frame-alist (defcustom ps-footer-frame-alist
'((fore-color . 0) '((fore-color . 0.0)
(back-color . 0.9) (back-color . 0.9)
(border-width . 0.4) (border-width . 0.4)
(border-color . 0) (border-color . 0.0)
(shadow-color . 0)) (shadow-color . 0.0))
"*Specify footer frame properties alist. "*Specify footer frame properties alist.
Don't change this alist directly, instead use customization, or `ps-value', Don't change this alist directly, instead use customization, or `ps-value',
@ -2456,9 +2456,9 @@ See also `ps-header-frame-alist' for documentation."
(const :format "" fore-color) (const :format "" fore-color)
(choice :menu-tag "Foreground Color" (choice :menu-tag "Foreground Color"
: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") (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 "Red")
(number :tag "Green") (number :tag "Green")
(number :tag "Blue")))) (number :tag "Blue"))))
@ -2479,9 +2479,9 @@ See also `ps-header-frame-alist' for documentation."
(const :format "" border-color) (const :format "" border-color)
(choice :menu-tag "Border Color" (choice :menu-tag "Border Color"
: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") (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 "Red")
(number :tag "Green") (number :tag "Green")
(number :tag "Blue")))) (number :tag "Blue"))))
@ -2489,9 +2489,9 @@ See also `ps-header-frame-alist' for documentation."
(const :format "" shadow-color) (const :format "" shadow-color)
(choice :menu-tag "Shadow Color" (choice :menu-tag "Shadow Color"
: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") (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 "Red")
(number :tag "Green") (number :tag "Green")
(number :tag "Blue")))))) (number :tag "Blue"))))))
@ -3274,34 +3274,14 @@ The table depends on the current ps-print setup."
(interactive (list (count-lines (mark) (point)))) (interactive (list (count-lines (mark) (point))))
(ps-nb-pages nb-lines)) (ps-nb-pages nb-lines))
(defvar ps-prefix-quote nil)
;;;###autoload ;;;###autoload
(defun ps-setup () (defun ps-setup ()
"Return the current PostScript-generation setup." "Return the current PostScript-generation setup."
(let (prefix) (let (ps-prefix-quote)
(mapconcat (mapconcat
#'(lambda (elt) #'ps-print-quote
(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))))))
))
(list (list
(concat "\n;;; ps-print version " ps-print-version "\n") (concat "\n;;; ps-print version " ps-print-version "\n")
'(25 . ps-print-color-p) '(25 . ps-print-color-p)
@ -3420,6 +3400,31 @@ The table depends on the current ps-print setup."
;; Utility functions and variables: ;; 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) (defun ps-value (alist-sym key)
"Return value from association list ALIST-SYM which car is `eq' to KEY." "Return value from association list ALIST-SYM which car is `eq' to KEY."
(cdr (assq key (symbol-value alist-sym)))) (cdr (assq key (symbol-value alist-sym))))
@ -4455,11 +4460,11 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
(defun ps-output-frame-properties (name alist) (defun ps-output-frame-properties (name alist)
(ps-output "/" name " [" (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-format-color (cdr (assq 'back-color alist)) 0.9)
(ps-float-format (or (cdr (assq 'border-width alist)) 0.4)) (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 'border-color alist)) 0.0)
(ps-format-color (cdr (assq 'shadow-color alist)) 0) (ps-format-color (cdr (assq 'shadow-color alist)) 0.0)
"]def\n")) "]def\n"))
@ -4507,12 +4512,13 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
(defun ps-float-format (value &optional default) (defun ps-float-format (value &optional default)
(let ((literal (or value default))) (let ((literal (or value default)))
(if literal (cond ((null literal)
(format (if (numberp literal) " ")
ps-float-format ((numberp literal)
"%s ") (format ps-float-format (* literal 1.0))) ; force float number
literal) (t
" "))) (format "%s " literal))
)))
(defun ps-background-text () (defun ps-background-text ()
@ -5297,9 +5303,9 @@ XSTART YSTART are the relative position for the first page in a sheet.")
(if (and the-color (listp the-color)) (if (and the-color (listp the-color))
(concat "[" (concat "["
(format ps-color-format (format ps-color-format
(nth 0 the-color) (* (nth 0 the-color) 1.0) ; force float number
(nth 1 the-color) (* (nth 1 the-color) 1.0) ; force float number
(nth 2 the-color)) (* (nth 2 the-color) 1.0)) ; force float number
"] ") "] ")
(ps-float-format (if (numberp the-color) the-color default))))) (ps-float-format (if (numberp the-color) the-color default)))))
@ -5644,15 +5650,16 @@ XSTART YSTART are the relative position for the first page in a sheet.")
(defun ps-plot-region (from to font &optional fg-color bg-color effects) (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)) (ps-set-font font))
;; Specify a foreground color only if one's specified and it's ;; Specify a foreground color only if one's specified and it's
;; different than the current. ;; different than the current.
(if (not (equal fg-color ps-current-color)) (let ((fg (or fg-color ps-default-foreground)))
(ps-set-color fg-color)) (or (equal fg ps-current-color)
(ps-set-color fg)))
(if (not (equal bg-color ps-current-bg)) (or (equal bg-color ps-current-bg)
(ps-set-bg bg-color)) (ps-set-bg bg-color))
;; Specify effects (underline, overline, box, etc) ;; Specify effects (underline, overline, box, etc)