procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix :foreground and :background face attributes

Browse source
This commit is contained in:
Vinicius Jose Latorre 2007-10-11 01:51:15 +00:00
parent c0bbca82a2
commit 42af7493ae
2 changed files with 48 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
lisp/ChangeLog
View file

@ -1,3 +1,16 @@
2007-10-10 Vinicius Jose Latorre <viniciusjl@ig.com.br>
* ps-print.el: Fix the usage of :foreground and :background face
attributes. Reported by Nikolaj Schumacher <n_schumacher@web.de>.
(ps-print-version): New version 7.2.5.
(ps-face-attributes, ps-face-attribute-list, ps-face-background): Fix
code.
(ps-face-foreground-color-p, ps-face-background-color-p)
(ps-face-color-p): New inline funs.
(ps-background, ps-begin-file, ps-build-reference-face-lists): Use
`mapc' rather than `mapcar'.
2007-08-29 Stefan Monnier <monnier@iro.umontreal.ca>
* simple.el (invisible-p): Remove: implemented in C now.

59
lisp/ps-print.el
View file

@ -10,11 +10,11 @@
;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Keywords: wp, print, PostScript
;; Version: 7.2.4
;; Version: 7.2.5
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
(defconst ps-print-version "7.2.4"
"ps-print.el, v 7.2.4 <2007/07/20 vinicius>
(defconst ps-print-version "7.2.5"
"ps-print.el, v 7.2.5 <2007/10/10 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
@ -4814,15 +4814,15 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
(defun ps-background (page-number)
(let (has-local-background)
(mapcar #'(lambda (range)
(and (<= (aref range 0) page-number)
(<= page-number (aref range 1))
(if has-local-background
(ps-output (aref range 2))
(setq has-local-background t)
(ps-output "/printLocalBackground{\n"
(aref range 2)))))
ps-background-pages)
(mapc #'(lambda (range)
(and (<= (aref range 0) page-number)
(<= page-number (aref range 1))
(if has-local-background
(ps-output (aref range 2))
(setq has-local-background t)
(ps-output "/printLocalBackground{\n"
(aref range 2)))))
ps-background-pages)
(and has-local-background (ps-output "}def\n"))))
@ -5458,7 +5458,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
(ps-output "\n" ps-print-prologue-1
"\n/printGlobalBackground{\n")
(mapcar 'ps-output ps-background-all-pages)
(mapc 'ps-output ps-background-all-pages)
(ps-output
"}def\n/printLocalBackground{\n}def\n"
"\n%%EndProlog\n\n%%BeginSetup\n"
@ -6091,6 +6091,18 @@ to the equivalent Latin-1 characters.")
(ps-output " S\n")))
(defsubst ps-face-foreground-color-p (attr)
(memq attr '(foreground-color :foreground)))
(defsubst ps-face-background-color-p (attr)
(memq attr '(background-color :background)))
(defsubst ps-face-color-p (attr)
(memq attr '(foreground-color :foreground background-color :background)))
(defun ps-face-attributes (face)
"Return face attribute vector.
@ -6114,9 +6126,9 @@ If FACE is not a valid face name, use default face."
(setq ps-print-face-alist
(cons new-face ps-print-face-alist)))
new-face))))
((eq (car face) 'foreground-color)
((ps-face-foreground-color-p (car face))
(vector 0 (cdr face) nil))
((eq (car face) 'background-color)
((ps-face-background-color-p (car face))
(vector 0 nil (cdr face)))
(t
(vector 0 nil nil))))
@ -6129,12 +6141,11 @@ If FACE is not a valid face name, use default face."
((symbolp face)
(memq face ps-use-face-background))
((listp face)
(or (memq (car face) '(foreground-color background-color))
(or (ps-face-color-p (car face))
(let (ok)
(while face
(if (or (memq (car face) ps-use-face-background)
(memq (car face)
'(foreground-color background-color)))
(ps-face-color-p (car face)))
(setq face nil
ok t)
(setq face (cdr face))))
@ -6151,10 +6162,10 @@ If FACE is not a valid face name, use default face."
((not (listp face-or-list))
(ps-face-attributes face-or-list))
;; only foreground color, not a `real' face
((eq (car face-or-list) 'foreground-color)
((ps-face-foreground-color-p (car face-or-list))
(vector 0 (cdr face-or-list) nil))
;; only background color, not a `real' face
((eq (car face-or-list) 'background-color)
((ps-face-background-color-p (car face-or-list))
(vector 0 nil (cdr face-or-list)))
;; list of faces
(t
@ -6209,10 +6220,10 @@ If FACE is not a valid face name, use default face."
;; Now, rebuild reference face lists
(setq ps-print-face-alist nil)
(if ps-auto-font-detect
(mapcar 'ps-map-face (face-list))
(mapcar 'ps-set-face-bold ps-bold-faces)
(mapcar 'ps-set-face-italic ps-italic-faces)
(mapcar 'ps-set-face-underline ps-underlined-faces))
(mapc 'ps-map-face (face-list))
(mapc 'ps-set-face-bold ps-bold-faces)
(mapc 'ps-set-face-italic ps-italic-faces)
(mapc 'ps-set-face-underline ps-underlined-faces))
(setq ps-build-face-reference nil))