Add 2012 to FSF copyright years for Emacs files.

[gnus] / lisp / shr-color.el

diff --git a/lisp/shr-color.el b/lisp/shr-color.el
index 78fd039..e23ab57 100644 (file)
--- a/lisp/shr-color.el
+++ b/lisp/shr-color.el
@@ -1,6 +1,6 @@
 ;;; shr-color.el --- Simple HTML Renderer color management
 
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
 
 ;; Author: Julien Danjou <julien@danjou.info>
 ;; Keywords: html
@@ -26,7 +26,8 @@
 
 ;;; Code:
 
-(require 'color-lab)
+(require 'color)
+(eval-when-compile (require 'cl))
 
 (defgroup shr-color nil
   "Simple HTML Renderer colors"
@@ -40,7 +41,7 @@ Must be between 0 and 100."
 
 (defcustom shr-color-visible-distance-min 5
   "Minimum color distance between two colors to be considered visible.
-This value is used to compare result for `ciede2000'. Its an
+This value is used to compare result for `ciede2000'.  It's an
 absolute value without any unit."
   :group 'shr
   :type 'integer)
@@ -197,7 +198,8 @@ absolute value without any unit."
 Each entry should have the form (COLOR-NAME . HEXADECIMAL-COLOR).")
 
 (defun shr-color-relative-to-absolute (number)
-  "Convert a relative NUMBER to absolute. If NUMBER is absolute, return NUMBER.
+  "Convert a relative NUMBER to absolute.
+If NUMBER is absolute, return NUMBER.
 This will convert \"80 %\" to 204, \"100 %\" to 255 but \"123\" to \"123\"."
   (let ((string-length (- (length number) 1)))
     ;; Is this a number with %?
@@ -258,7 +260,7 @@ Like rgb() or hsl()."
             (l (/ (string-to-number (match-string-no-properties 3 color)) 100.0)))
         (destructuring-bind (r g b)
             (shr-color-hsl-to-rgb-fractions h s l)
-          (format "#%02X%02X%02X" (* r 255) (* g 255) (* b 255)))))
+          (color-rgb-to-hex r g b))))
      ;; Color names
      ((cdr (assoc-string color shr-color-html-colors-alist t)))
      ;; Unrecognized color :(
@@ -268,7 +270,7 @@ Like rgb() or hsl()."
 (defun set-minimum-interval (val1 val2 min max interval &optional fixed)
   "Set minimum interval between VAL1 and VAL2 to INTERVAL.
 The values are bound by MIN and MAX.
-If FIXED is t, then val1 will not be touched."
+If FIXED is t, then VAL1 will not be touched."
   (let ((diff (abs (- val1 val2))))
     (unless (>= diff interval)
       (if fixed
@@ -318,32 +320,42 @@ If FIXED is t, then val1 will not be touched."
 
 (defun shr-color-visible (bg fg &optional fixed-background)
   "Check that BG and FG colors are visible if they are drawn on each other.
-Return t if they are. If they are too similar, two new colors are
-returned instead.
+Return (bg fg) if they are.  If they are too similar, two new
+colors are returned instead.
 If FIXED-BACKGROUND is set, and if the color are not visible, a
-new background color will not be computed. Only the foreground
+new background color will not be computed.  Only the foreground
 color will be adapted to be visible on BG."
   ;; Convert fg and bg to CIE Lab
-  (let* ((fg-lab (apply 'rgb->lab (rgb->normalize fg)))
-         (bg-lab (apply 'rgb->lab (rgb->normalize bg)))
-         ;; Compute color distance using CIE DE 2000
-         (fg-bg-distance (color-lab-ciede2000 fg-lab bg-lab))
-         ;; Compute luminance distance (substract L component)
-         (luminance-distance (abs (- (car fg-lab) (car bg-lab)))))
-    (if (and (>= fg-bg-distance shr-color-visible-distance-min)
-             (>= luminance-distance shr-color-visible-luminance-min))
-        (list bg fg)
-      ;; Not visible, try to change luminance to make them visible
-      (let ((Ls (set-minimum-interval (car bg-lab) (car fg-lab) 0 100
-                                      shr-color-visible-luminance-min
-                                      fixed-background)))
-        (setcar bg-lab (car Ls))
-        (setcar fg-lab (cadr Ls))
-        (list
-         (apply 'format "#%02x%02x%02x"
-                (mapcar (lambda (x) (* (max (min 1 x) 0) 255)) (apply 'lab->rgb bg-lab)))
-         (apply 'format "#%02x%02x%02x"
-                (mapcar (lambda (x) (* (max (min 1 x) 0) 255)) (apply 'lab->rgb fg-lab))))))))
+  (let ((fg-norm (color-name-to-rgb fg))
+       (bg-norm (color-name-to-rgb bg)))
+    (if (or (null fg-norm)
+           (null bg-norm))
+       (list bg fg)
+      (let* ((fg-lab (apply 'color-srgb-to-lab fg-norm))
+            (bg-lab (apply 'color-srgb-to-lab bg-norm))
+            ;; Compute color distance using CIE DE 2000
+            (fg-bg-distance (color-cie-de2000 fg-lab bg-lab))
+            ;; Compute luminance distance (subtract L component)
+            (luminance-distance (abs (- (car fg-lab) (car bg-lab)))))
+       (if (and (>= fg-bg-distance shr-color-visible-distance-min)
+                (>= luminance-distance shr-color-visible-luminance-min))
+           (list bg fg)
+         ;; Not visible, try to change luminance to make them visible
+         (let ((Ls (set-minimum-interval (car bg-lab) (car fg-lab) 0 100
+                                         shr-color-visible-luminance-min
+                                         fixed-background)))
+           (unless fixed-background
+             (setcar bg-lab (car Ls)))
+           (setcar fg-lab (cadr Ls))
+           (list
+            (if fixed-background
+                bg
+              (apply 'format "#%02x%02x%02x"
+                     (mapcar (lambda (x) (* (max (min 1 x) 0) 255))
+                             (apply 'color-lab-to-srgb bg-lab))))
+            (apply 'format "#%02x%02x%02x"
+                   (mapcar (lambda (x) (* (max (min 1 x) 0) 255))
+                           (apply 'color-lab-to-srgb fg-lab))))))))))
 
 (provide 'shr-color)