X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fshr-color.el;h=afb56ae38a70f7a0d43332ac31adc564f2212e3a;hb=400a77ad86dccb7c5c4904162d18aa7716f9470f;hp=d611609e39c2aca1d06302ea149d9ec7a7b32845;hpb=748a26d641dd1996f89f290d7e276bcb955e4056;p=gnus

diff --git a/lisp/shr-color.el b/lisp/shr-color.el
index d611609e3..afb56ae38 100644
--- a/lisp/shr-color.el
+++ b/lisp/shr-color.el
@@ -26,7 +26,8 @@
 
 ;;; Code:
 
-(require 'color-lab)
+(require 'color)
+(eval-when-compile (require 'cl))
 
 (defgroup shr-color nil
   "Simple HTML Renderer colors"
@@ -231,10 +232,10 @@ Like rgb() or hsl()."
   (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)
+      (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*)"
@@ -258,10 +259,9 @@ 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->hex r g b))))
      ;; 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))))
@@ -319,32 +319,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
 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-rgb->normalize fg))
+	(bg-norm (color-rgb->normalize bg)))
+    (if (or (null fg-norm)
+	    (null bg-norm))
+	(list bg fg)
+      (let* ((fg-lab (apply 'color-srgb->lab fg-norm))
+	     (bg-lab (apply 'color-srgb->lab bg-norm))
+	     ;; Compute color distance using CIE DE 2000
+	     (fg-bg-distance (color-cie-de2000 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)))
+	    (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->srgb bg-lab))))
+	     (apply 'format "#%02x%02x%02x"
+		    (mapcar (lambda (x) (* (max (min 1 x) 0) 255))
+			    (apply 'color-lab->srgb fg-lab))))))))))
 
 (provide 'shr-color)