diff options
| -rw-r--r-- | lisp/ChangeLog | 13 | ||||
| -rw-r--r-- | lisp/ps-print.el | 59 |
2 files changed, 48 insertions, 24 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 06ceba6a157..9a5b277201a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -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. diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 928f688f4c6..e385bd484f7 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -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)) |