Fix :foreground and :background face attributes

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 06ceba6a157678069fc65a86ea948d30b24ad2e3..9a5b277201a1ac9b8cdf49fa371be93953d3493d 100644 (file)
--- 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 928f688f4c60036528a2a0d3f61c6cf18d0abff3..e385bd484f7417e6889bf5a77a586ce164155963 100644 (file)
--- 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))