nnir.el: Fix byte-compile warning.
[gnus] / lisp / shr-color.el
index 1c9790d..91b2cf7 100644 (file)
@@ -1,6 +1,6 @@
 ;;; shr-color.el --- Simple HTML Renderer color management
 
 ;;; shr-color.el --- Simple HTML Renderer color management
 
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
 
 ;; Author: Julien Danjou <julien@danjou.info>
 ;; Keywords: html
 
 ;; Author: Julien Danjou <julien@danjou.info>
 ;; Keywords: html
@@ -27,6 +27,7 @@
 ;;; Code:
 
 (require 'color)
 ;;; Code:
 
 (require 'color)
+(eval-when-compile (require 'cl))
 
 (defgroup shr-color nil
   "Simple HTML Renderer colors"
 
 (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.
 
 (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)
 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)
 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 %?
 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,17 +260,18 @@ 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)
             (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 :(
      (t
       nil))))
 
      ;; Color names
      ((cdr (assoc-string color shr-color-html-colors-alist t)))
      ;; Unrecognized color :(
      (t
       nil))))
 
-(defun set-minimum-interval (val1 val2 min max interval &optional fixed)
+(defun shr-color-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.
   "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
   (let ((diff (abs (- val1 val2))))
     (unless (>= diff interval)
       (if fixed
@@ -318,30 +321,30 @@ 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.
 
 (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 (bg fg) if they are. If they are too similar, two new
+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
 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
 color will be adapted to be visible on BG."
   ;; Convert fg and bg to CIE Lab
-  (let ((fg-norm (color-rgb->normalize fg))
-       (bg-norm (color-rgb->normalize bg)))
+  (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)
     (if (or (null fg-norm)
            (null bg-norm))
        (list bg fg)
-      (let* ((fg-lab (apply 'color-rgb->lab fg-norm))
-            (bg-lab (apply 'color-rgb->lab bg-norm))
+      (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 color distance using CIE DE 2000
             (fg-bg-distance (color-cie-de2000 fg-lab bg-lab))
-            ;; Compute luminance distance (substract L component)
+            ;; 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
             (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)))
+         (let ((Ls (shr-color-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))
            (unless fixed-background
              (setcar bg-lab (car Ls)))
            (setcar fg-lab (cadr Ls))
@@ -350,10 +353,10 @@ color will be adapted to be visible on BG."
                 bg
               (apply 'format "#%02x%02x%02x"
                      (mapcar (lambda (x) (* (max (min 1 x) 0) 255))
                 bg
               (apply 'format "#%02x%02x%02x"
                      (mapcar (lambda (x) (* (max (min 1 x) 0) 255))
-                             (apply 'color-lab->rgb bg-lab))))
+                             (apply 'color-lab-to-srgb bg-lab))))
             (apply 'format "#%02x%02x%02x"
                    (mapcar (lambda (x) (* (max (min 1 x) 0) 255))
             (apply 'format "#%02x%02x%02x"
                    (mapcar (lambda (x) (* (max (min 1 x) 0) 255))
-                           (apply 'color-lab->rgb fg-lab))))))))))
+                           (apply 'color-lab-to-srgb fg-lab))))))))))
 
 (provide 'shr-color)
 
 
 (provide 'shr-color)