Detect if text foreground and background are equals

2 files changed, 147 insertions, 50 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f1ad1c7620e..27fe92bad28 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -21,6 +21,18 @@
         * cus-start.el: Remove abbrev-all-caps and pre-abbrev-expand-hook.
         * loadup.el: Load "abbrev.el" before "lisp-mode.el".
 
+2007-10-27  Vinicius Jose Latorre  <viniciusjl@ig.com.br>
+
+        * ps-print.el: Now detect if text foreground and background colors are
+        equals and replace the foreground color by another color, so the text
+        becomes visible.  Doc fix.
+        (ps-print-version): New version 6.8.
+        (ps-default-fg, ps-default-bg): Docstring fix.
+        (ps-postscript-code-directory): Fix default value code.
+        (ps-fg-list, ps-fg-validate-p): New options.
+        (ps-foreground-list): New var.
+        (ps-setup, ps-begin-job, ps-plot-region): Fix code.
+
 2007-10-27  Glenn Morris  <rgm@gnu.org>
 
         * shell.el (shell-dirtrack-verbose, shell-directory-tracker): Doc fix.
@@ -88,7 +100,7 @@
         (pr-menu-set-ps-title, pr-menu-set-txt-title, pr-region-active-p)
         (pr-do-update-menus, pr-update-mode-line, pr-f-read-string)
         (pr-f-set-keymap-parents, pr-keep-region-active): Fun aliases.
-        (defvar pr-menu-print-item, pr-ps-printer-menu-modified)
+        (pr-menu-print-item, pr-ps-printer-menu-modified)
         (pr-txt-printer-menu-modified, pr-ps-utility-menu-modified)
         (pr-even-or-odd-alist): Vars definition moved.
 
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 49b0960f9bb..1466c6dbb23 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: 6.7.6
+;; Version: 6.8
 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
 
-(defconst ps-print-version "6.7.6"
-  "ps-print.el, v 6.7.6 <2007/10/10 vinicius>
+(defconst ps-print-version "6.8"
+  "ps-print.el, v 6.8 <2007/10/26 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
@@ -1089,6 +1089,14 @@ Please send all bug fixes and enhancements to
 ;; You can also set `ps-print-color-p' to 'black-white to have a better looking
 ;; on black/white printers.  See also `ps-black-white-faces' for documentation.
 ;;
+;; ps-print also detects if the text foreground and background colors are
+;; equals when `ps-fg-validate-p' is non-nil.  In this case, if these colors
+;; are used, no text will appear.  You can use `ps-fg-list' to give a list of
+;; foreground colors to be used when text foreground and background colors are
+;; equals.  It'll be used the first foreground color in `ps-fg-list' which is
+;; different from the background color.  If `ps-fg-list' is nil, the default
+;; foreground color is used. 
+;;
 ;;
 ;; How Ps-Print Maps Faces
 ;; -----------------------
@@ -1212,85 +1220,88 @@ Please send all bug fixes and enhancements to
 ;;
 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;;
-;;    20040229
+;;    2007-10-27
+;;       `ps-fg-validate-p', `ps-fg-list'
+;;
+;;    2004-02-29
 ;;       `ps-time-stamp-yyyy-mm-dd', `ps-time-stamp-iso8601'
 ;;
-;;    20010619
+;;    2001-06-19
 ;;       `ps-time-stamp-locale-default'
 ;;
-;;    20010530
+;;    2001-05-30
 ;;       Handle before-string and after-string overlay properties.
 ;;
-;;    20010407
+;;    2001-04-07
 ;;       `ps-line-number-color', `ps-print-footer', `ps-footer-offset',
 ;;       `ps-print-footer-frame', `ps-footer-font-family',
 ;;       `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines',
 ;;       `ps-left-footer', `ps-right-footer', `ps-footer-frame-alist' and
 ;;       `ps-header-frame-alist'.
 ;;
-;;    20010328
+;;    2001-03-28
 ;;       `ps-line-spacing', `ps-paragraph-spacing', `ps-paragraph-regexp',
 ;;       `ps-begin-cut-regexp' and `ps-end-cut-regexp'.
 ;;
-;;    20001122
+;;    2000-11-22
 ;;       `ps-line-number-font', `ps-line-number-font-size' and
 ;;       `ps-end-with-control-d'.
 ;;
-;;    20000821
+;;    2000-08-21
 ;;       `ps-even-or-odd-pages'
 ;;
-;;    20000617
+;;    2000-06-17
 ;;       `ps-manual-feed', `ps-warn-paper-type', `ps-print-upside-down',
 ;;       `ps-selected-pages', `ps-last-selected-pages',
 ;;       `ps-restore-selected-pages', `ps-switch-header',
 ;;       `ps-line-number-step', `ps-line-number-start',
 ;;       `ps-zebra-stripe-follow' and `ps-use-face-background'.
 ;;
-;;    20000310
+;;    2000-03-10
 ;;       PostScript error handler.
 ;;       `ps-user-defined-prologue' and `ps-error-handler-message'.
 ;;
-;;    19991211
+;;    1999-12-11
 ;;       `ps-print-customize'.
 ;;
-;;    19990703
+;;    1999-07-03
 ;;       Better customization.
 ;;       `ps-banner-page-when-duplexing' and `ps-zebra-color'.
 ;;
-;;    19990513
+;;    1999-05-13
 ;;       N-up printing.
 ;;       Hook: `ps-print-begin-sheet-hook'.
 ;;
-;; [kenichi] 19990509 Ken'ichi Handa <handa@m17n.org>
+;; [kenichi] 1999-05-09 Ken'ichi Handa <handa@m17n.org>
 ;;
 ;;    `ps-print-region-function'
 ;;
 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;;
-;;    19990301
+;;    1999-03-01
 ;;       PostScript tumble and setpagedevice.
 ;;
-;;    19980922
+;;    1998-09-22
 ;;       PostScript prologue header comment insertion.
 ;;       Skip invisible text better.
 ;;
-;; [kenichi] 19980819 Ken'ichi Handa <handa@m17n.org>
+;; [kenichi] 1998-08-19 Ken'ichi Handa <handa@m17n.org>
 ;;
 ;;    Multi-byte buffer handling.
 ;;
 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;;
-;;    19980306
+;;    1998-03-06
 ;;       Skip invisible text.
 ;;
-;;    19971130
+;;    1997-11-30
 ;;       Hooks: `ps-print-hook', `ps-print-begin-page-hook' and
 ;;       `ps-print-begin-column-hook'.
 ;;       Put one header per page over the columns.
 ;;       Better database font management.
 ;;       Better control characters handling.
 ;;
-;;    19971121
+;;    1997-11-21
 ;;       Dynamic evaluation at print time of `ps-lpr-switches'.
 ;;       Handle control characters.
 ;;       Face remapping.
@@ -1299,12 +1310,12 @@ Please send all bug fixes and enhancements to
 ;;       Zebra stripes.
 ;;       Text and/or image on background.
 ;;
-;; [jack] 19960517 Jacques Duthen <duthen@cegelec-red.fr>
+;; [jack] 1996-05-17 Jacques Duthen <duthen@cegelec-red.fr>
 ;;
-;; Font family and float size for text and header.
-;; Landscape mode.
-;; Multiple columns.
-;; Tools for page setup.
+;;    Font family and float size for text and header.
+;;    Landscape mode.
+;;    Multiple columns.
+;;    Tools for page setup.
 ;;
 ;;
 ;; Known bugs and limitations of ps-print
@@ -1343,8 +1354,11 @@ Please send all bug fixes and enhancements to
 ;; ----------------
 ;;
 ;; Avoid page break inside a paragraph.
+;;
 ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
+;;
 ;; Improve the memory management for big files (hard?).
+;;
 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care of folding
 ;; lines.
 ;;
@@ -3014,7 +3028,7 @@ Valid values are:
    LIST         It's a list of RGB values, that is a list of three real values
                 of the form:
 
-                  (RED, GREEN, BLUE)
+                  (RED GREEN BLUE)
 
                 Where RED, GREEN and BLUE are reals between 0.0 (no color) and
                 1.0 (full color).
@@ -3058,7 +3072,7 @@ Valid values are:
    LIST         It's a list of RGB values, that is a list of three real values
                 of the form:
 
-                  (RED, GREEN, BLUE)
+                  (RED GREEN BLUE)
 
                 Where RED, GREEN and BLUE are reals between 0.0 (no color) and
                 1.0 (full color).
@@ -3082,6 +3096,58 @@ See also `ps-use-face-background'."
   :version "20"
   :group 'ps-print-color)
 
+(defcustom ps-fg-list nil
+  "*Specify foreground color list.
+
+This list is used to chose a text foreground color which is different than the
+background color.  It'll be used the first foreground color in `ps-fg-list'
+which is different from the background color.
+
+If this list is nil, the default foreground color is used.  See
+`ps-default-fg'.
+
+The list element valid values are:
+
+   NUMBER       It's a real value between 0.0 (black) and 1.0 (white) that
+                indicate the gray color.
+
+   COLOR-NAME   It's a string which contains the color name.  For example:
+                \"yellow\".
+
+   LIST         It's a list of RGB values, that is a list of three real values
+                of the form:
+
+                  (RED GREEN BLUE)
+
+                Where RED, GREEN and BLUE are reals between 0.0 (no color) and
+                1.0 (full color).
+
+Any other value is ignored and black color will be used.
+
+This variable is used only when `ps-fg-validate-p' (which see) is non-nil and
+when `ps-print-color-p' (which see) is neither nil nor black-white."
+  :type '(repeat
+          (choice :menu-tag "Foreground Gray/Color"
+                  :tag "Foreground Gray/Color"
+                  (number :tag "Gray Scale" :value 0.0)
+                  (string :tag "Color Name" :value "black")
+                  (list :tag "RGB Color" :value (0.0 0.0 0.0)
+                        (number :tag "Red")
+                        (number :tag "Green")
+                        (number :tag "Blue"))))
+  :version "22"
+  :group 'ps-print-color)
+
+(defcustom ps-fg-validate-p t
+  "*Non-nil means validate if foreground color is different than background.
+
+If text foreground and background colors are equals, no text will appear.
+
+See also `ps-fg-list'."
+  :type 'boolean
+  :version "22"
+  :group 'ps-print-color)
+
 (defcustom ps-auto-font-detect t
   "*Non-nil means automatically detect bold/italic/underline face attributes.
 If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces', and
@@ -3346,9 +3412,9 @@ It's like the very first character of buffer (or region) is ^L (\\014)."
 (defcustom ps-postscript-code-directory
   (or (if (featurep 'xemacs)
           (cond ((fboundp 'locate-data-directory) ; XEmacs
-                 (locate-data-directory "ps-print"))
+                 (funcall 'locate-data-directory "ps-print"))
                 ((boundp 'data-directory) ; XEmacs
-                 data-directory)
+                 (symbol-value 'data-directory))
                 (t                      ; don't know what to do
                  nil))
         data-directory)                 ; Emacs
@@ -3627,9 +3693,11 @@ The table depends on the current ps-print setup."
       '(23 . ps-line-number-step)
       '(23 . ps-line-number-start)
       nil
-      '(17 . ps-default-fg)
-      '(17 . ps-default-bg)
       '(17 . ps-razzle-dazzle)
+      '(17 . ps-default-bg)
+      '(17 . ps-default-fg)
+      '(17 . ps-fg-validate-p)
+      '(17 . ps-fg-list)
       nil
       '(23 . ps-use-face-background)
       nil
@@ -3709,9 +3777,9 @@ The table depends on the current ps-print setup."
       '(20 . ps-underlined-faces)
       '(20 . ps-black-white-faces)
       "      )\n
-;; The following customized variables have long lists and are seldom modified:
-;;    ps-page-dimensions-database
-;;    ps-font-info-database
+\;; The following customized variables have long lists and are seldom modified:
+\;;    ps-page-dimensions-database
+\;;    ps-font-info-database
 
 \;;; ps-print - end of settings\n")
      "\n")))
@@ -4020,6 +4088,7 @@ Note: No major/minor-mode is activated and no local variables are evaluated for
 (defvar ps-default-color nil)
 (defvar ps-current-color nil)
 (defvar ps-current-bg nil)
+(defvar ps-foreground-list nil)
 
 (defvar ps-zebra-stripe-full-p nil)
 (defvar ps-razchunk 0)
@@ -5957,6 +6026,14 @@ XSTART YSTART are the relative position for the first page in a sheet.")
                                  ps-default-fg))
                                "unspecified-fg"
                                0.0)
+        ps-foreground-list    (mapcar
+                               #'(lambda (arg)
+                                   (ps-rgb-color arg "unspecified-fg" 0.0))
+                               (append (and (not (member ps-print-color-p
+                                                         '(nil back-white)))
+                                            ps-fg-list)
+                                       (list ps-default-foreground
+                                             "black")))
         ps-default-color      (and (not (member ps-print-color-p
                                                 '(nil back-white)))
                                    ps-default-foreground)
@@ -6200,16 +6277,24 @@ to the equivalent Latin-1 characters.")
   (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.
+  ;; Specify a foreground color only if:
+  ;;    one's specified,
+  ;;    it's different than the background (if `ps-fg-validate-p' is non-nil)
+  ;;    and it's different than the current.
   (let ((fg (or fg-color ps-default-foreground)))
+    (if ps-fg-validate-p
+        (let ((bg (or bg-color ps-default-background))
+              (el ps-foreground-list))
+          (while (and el (equal fg bg))
+            (setq fg (car el)
+                  el (cdr el)))))
     (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)
+  ;; Specify effects (underline, overline, box, etc.)
   (cond
    ((not (integerp effects))
     (ps-output "0 EF\n")
@@ -6385,7 +6470,7 @@ If FACE is not a valid face name, use default face."
 
 
 (defun ps-face-background (face background)
-  (and (cond ((eq ps-use-face-background t))    ; always
+  (and (cond ((eq ps-use-face-background t))     ; always
              ((null ps-use-face-background) nil) ; never
              ;; ps-user-face-background is a symbol face list
              ((symbolp face)
@@ -7111,20 +7196,20 @@ Valid values are:
 
 Any other value is treated as nil.")
 
-(custom-autoload (quote ps-multibyte-buffer) "ps-mule" t)
+(custom-autoload 'ps-multibyte-buffer "ps-mule" t)
 
-(autoload (quote ps-mule-prepare-ascii-font) "ps-mule" "\
+(autoload 'ps-mule-prepare-ascii-font "ps-mule" "\
 Setup special ASCII font for STRING.
 STRING should contain only ASCII characters.
 
 \(fn STRING)" nil nil)
 
-(autoload (quote ps-mule-set-ascii-font) "ps-mule" "\
+(autoload 'ps-mule-set-ascii-font "ps-mule" "\
 Not documented
 
 \(fn)" nil nil)
 
-(autoload (quote ps-mule-plot-string) "ps-mule" "\
+(autoload 'ps-mule-plot-string "ps-mule" "\
 Generate PostScript code for plotting characters in the region FROM and TO.
 
 It is assumed that all characters in this region belong to the same charset.
@@ -7140,7 +7225,7 @@ the sequence.
 
 \(fn FROM TO &optional BG-COLOR)" nil nil)
 
-(autoload (quote ps-mule-plot-composition) "ps-mule" "\
+(autoload 'ps-mule-plot-composition "ps-mule" "\
 Generate PostScript code for plotting composition in the region FROM and TO.
 
 It is assumed that all characters in this region belong to the same
@@ -7157,24 +7242,24 @@ the sequence.
 
 \(fn FROM TO &optional BG-COLOR)" nil nil)
 
-(autoload (quote ps-mule-initialize) "ps-mule" "\
+(autoload 'ps-mule-initialize "ps-mule" "\
 Initialize global data for printing multi-byte characters.
 
 \(fn)" nil nil)
 
-(autoload (quote ps-mule-encode-header-string) "ps-mule" "\
+(autoload 'ps-mule-encode-header-string "ps-mule" "\
 Generate PostScript code for ploting STRING by font FONTTAG.
 FONTTAG should be a string \"/h0\" or \"/h1\".
 
 \(fn STRING FONTTAG)" nil nil)
 
-(autoload (quote ps-mule-begin-job) "ps-mule" "\
+(autoload 'ps-mule-begin-job "ps-mule" "\
 Start printing job for multi-byte chars between FROM and TO.
 It checks if all multi-byte characters in the region are printable or not.
 
 \(fn FROM TO)" nil nil)
 
-(autoload (quote ps-mule-begin-page) "ps-mule" "\
+(autoload 'ps-mule-begin-page "ps-mule" "\
 Not documented
 
 \(fn)" nil nil)