color-lab.el: Fix all expt calls to use float type.

shr-color.el: only return hexadecimal part of colors.
shr.el: Protect against non-existant colour names.

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index e9a92acc79015444b46a065429867d4a384f4770..9385d2d774758d57431ae0d54a382982520ab461 100644 (file)
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,16 @@
+2010-11-24  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * shr.el (shr-color-check): Protect against non-existant colour names.
+
+2010-11-24  Julien Danjou  <julien@danjou.info>
+
+       * shr.el (shr-insert-color-overlay): Remove specific rgb() check.
+
+       * shr-color.el (shr-color->hexadecimal): Only return the hexadecimal
+       matched part.
+
+       * color-lab.el: Fix all expt calls to use float type.
+
 2010-11-24  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * shr.el (shr-insert-color-overlay): Pass rgb(rrr, ggg, bbb) type color

diff --git a/lisp/gnus/color-lab.el b/lisp/gnus/color-lab.el
index c5a953cea35dacf253b1cf8d2787a5bfed2626a8..35e75d435030b7fbdd6d170f472cae86e4c90de2 100644 (file)
--- a/lisp/gnus/color-lab.el
+++ b/lisp/gnus/color-lab.el
@@ -153,14 +153,14 @@ none is set, `color-lab-d65-xyz' is used."
       (let* ((fy (/ (+ L 16) 116.0))
              (fz (- fy (/ b 200.0)))
              (fx (+ (/ a 500.0) fy))
-             (xr (if (> (expt fx 3) color-lab-ε)
-                     (expt fx 3)
+             (xr (if (> (expt fx 3.0) color-lab-ε)
+                     (expt fx 3.0)
                (/ (- (* fx 116) 16) color-lab-κ)))
              (yr (if (> L (* color-lab-κ color-lab-ε))
-                     (expt (/ (+ L 16) 116.0) 3)
+                     (expt (/ (+ L 16) 116.0) 3.0)
                    (/ L color-lab-κ)))
              (zr (if (> (expt fz 3) color-lab-ε)
-                     (expt fz 3)
+                     (expt fz 3.0)
                    (/ (- (* 116 fz) 16) color-lab-κ))))
         (list (* xr Xr)                 ; X
               (* yr Yr)                 ; Y
@@ -186,14 +186,14 @@ Colors must be in CIE L*a*b* format."
       (let* ((kL (or kL 1))
              (kC (or kC 1))
              (kH (or kH 1))
-             (C₁ (sqrt (+ (expt a₁ 2) (expt b₁ 2))))
-             (C₂ (sqrt (+ (expt a₂ 2) (expt b₂ 2))))
+             (C₁ (sqrt (+ (expt a₁ 2.0) (expt b₁ 2.0))))
+             (C₂ (sqrt (+ (expt a₂ 2.0) (expt b₂ 2.0))))
              (C̄ (/ (+ C₁ C₂) 2.0))
-             (G (* 0.5 (- 1 (sqrt (/ (expt C̄ 7) (+ (expt C̄ 7) (expt 25 7)))))))
+             (G (* 0.5 (- 1 (sqrt (/ (expt C̄ 7.0) (+ (expt C̄ 7.0) (expt 25 7.0)))))))
              (a′₁ (* (+ 1 G) a₁))
              (a′₂ (* (+ 1 G) a₂))
-             (C′₁ (sqrt (+ (expt a′₁ 2) (expt b₁ 2))))
-             (C′₂ (sqrt (+ (expt a′₂ 2) (expt b₂ 2))))
+             (C′₁ (sqrt (+ (expt a′₁ 2.0) (expt b₁ 2.0))))
+             (C′₂ (sqrt (+ (expt a′₂ 2.0) (expt b₂ 2.0))))
              (h′₁ (if (and (= b₁ 0) (= a′₁ 0))
                       0
                     (let ((v (atan b₁ a′₁)))
@@ -232,15 +232,15 @@ Colors must be in CIE L*a*b* format."
                    (* 0.24 (cos (* h̄′ 2)))
                    (* 0.32 (cos (+ (* h̄′ 3) (degrees-to-radians 6))))
                    (- (* 0.20 (cos (- (* h̄′ 4) (degrees-to-radians 63)))))))
-             (Δθ (* (degrees-to-radians 30) (exp (- (expt (/ (- h̄′ (degrees-to-radians 275)) (degrees-to-radians 25)) 2)))))
-             (Rc (* 2 (sqrt (/ (expt C̄′ 7) (+ (expt C̄′ 7) (expt 25 7))))))
-             (Sl (+ 1 (/ (* 0.015 (expt (- L̄′ 50) 2)) (sqrt (+ 20 (expt (- L̄′ 50) 2))))))
+             (Δθ (* (degrees-to-radians 30) (exp (- (expt (/ (- h̄′ (degrees-to-radians 275)) (degrees-to-radians 25)) 2.0)))))
+             (Rc (* 2 (sqrt (/ (expt C̄′ 7.0) (+ (expt C̄′ 7.0) (expt 25.0 7.0))))))
+             (Sl (+ 1 (/ (* 0.015 (expt (- L̄′ 50) 2.0)) (sqrt (+ 20 (expt (- L̄′ 50) 2.0))))))
              (Sc (+ 1 (* C̄′ 0.045)))
              (Sh (+ 1 (* 0.015 C̄′ T)))
              (Rt (- (* (sin (* Δθ 2)) Rc))))
-        (sqrt (+ (expt (/ ΔL′ (* Sl kL)) 2)
-                 (expt (/ ΔC′ (* Sc kC)) 2)
-                 (expt (/ ΔH′ (* Sh kH)) 2)
+        (sqrt (+ (expt (/ ΔL′ (* Sl kL)) 2.0)
+                 (expt (/ ΔC′ (* Sc kC)) 2.0)
+                 (expt (/ ΔH′ (* Sh kH)) 2.0)
                  (* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH)))))))))
 
 (provide 'color-lab)

diff --git a/lisp/gnus/shr-color.el b/lisp/gnus/shr-color.el
index 1e96567380325fce625945c921ee498035a14b56..78fd0395290dbbc99f85e0abb3a1fd28ec67a706 100644 (file)
--- a/lisp/gnus/shr-color.el
+++ b/lisp/gnus/shr-color.el
@@ -231,10 +231,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*)"

diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index 3d3b199cd7e54412a5bc1ae0388b3b2e60c5435f..36c8d703e4614e66fe6ca25eed484520bb275106 100644 (file)
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -496,18 +496,18 @@ START, and END."
 (autoload 'shr-color->hexadecimal "shr-color")
 (defun shr-color-check (fg &optional bg)
   "Check that FG is visible on BG."
-  (shr-color-visible (or (shr-color->hexadecimal bg)
-                         (frame-parameter nil 'background-color))
-                     (shr-color->hexadecimal fg) (not bg)))
+  (let ((hex-color (shr-color->hexadecimal fg)))
+    (when hex-color
+      (shr-color-visible (or (shr-color->hexadecimal bg)
+                            (frame-parameter nil 'background-color))
+                        hex-color (not bg)))))
 
 (defun shr-insert-color-overlay (color start end)
   (when color
-    (when (and (not (string-match "\\`rgb([^\)]+)\\'" color))
-              (string-match " " color))
-      (setq color (car (split-string color))))
-    (let ((overlay (make-overlay start end)))
-      (overlay-put overlay 'face (cons 'foreground-color
-                                      (cadr (shr-color-check color)))))))
+    (let ((new-color (cadr (shr-color-check color))))
+      (when new-color
+       (overlay-put (make-overlay start end) 'face
+                    (cons 'foreground-color new-color))))))
 
 ;;; Tag-specific rendering rules.