Add hooks for gcc handling

[gnus] / lisp / shr-color.el

diff --git a/lisp/shr-color.el b/lisp/shr-color.el
index d611609..7011034 100644 (file)
--- a/lisp/shr-color.el
+++ b/lisp/shr-color.el
@@ -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-2012 Free Software Foundation, Inc.

 
 ;; Author: Julien Danjou <julien@danjou.info>
 ;; Keywords: html
 
 ;; Author: Julien Danjou <julien@danjou.info>
 ;; Keywords: html


@@ -26,7 +26,8 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(require 'color-lab)
+(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 %?


@@ -231,10 +233,10 @@ Like rgb() or hsl()."
   (when color
     (cond
      ;; Hexadecimal color: #abc or #aabbcc
   (when color
     (cond
      ;; Hexadecimal color: #abc or #aabbcc

-     ((string-match-p
-       "#[0-9a-fA-F]\\{3\\}[0-9a-fA-F]\\{3\\}?"
+     ((string-match
+       "\\(#[0-9a-fA-F]\\{3\\}[0-9a-fA-F]\\{3\\}?\\)"

        color)
        color)

-      color)
+      (match-string 1 color))

      ;; rgb() or rgba() colors
      ((or (string-match
            "rgb(\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*)"
      ;; rgb() or rgba() colors
      ((or (string-match
            "rgb(\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*)"


@@ -258,18 +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
      ;; Color names

-     ((assoc color shr-color-html-colors-alist)
-      (cdr (assoc-string color shr-color-html-colors-alist t)))
+     ((cdr (assoc-string color shr-color-html-colors-alist t)))

      ;; Unrecognized color :(
      (t
       nil))))
 
      ;; 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


@@ -319,32 +321,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.
 
 (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
 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-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 (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))
+           (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)
 
 
 (provide 'shr-color)