Mercurial > emacs
changeset 111701:3fbe2d0ad0f8
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.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Wed, 24 Nov 2010 11:32:22 +0000 |
| parents | 3242c8febbd0 |
| children | 087bcfbfa5ef |
| files | lisp/gnus/ChangeLog lisp/gnus/color-lab.el lisp/gnus/shr-color.el lisp/gnus/shr.el |
| diffstat | 4 files changed, 40 insertions(+), 27 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Wed Nov 24 08:50:08 2010 +0100 +++ b/lisp/gnus/ChangeLog Wed Nov 24 11:32:22 2010 +0000 @@ -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
--- a/lisp/gnus/color-lab.el Wed Nov 24 08:50:08 2010 +0100 +++ b/lisp/gnus/color-lab.el Wed Nov 24 11:32:22 2010 +0000 @@ -153,14 +153,14 @@ (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 @@ (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 @@ (* 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)
--- a/lisp/gnus/shr-color.el Wed Nov 24 08:50:08 2010 +0100 +++ b/lisp/gnus/shr-color.el Wed Nov 24 11:32:22 2010 +0000 @@ -231,10 +231,10 @@ (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*)"
--- a/lisp/gnus/shr.el Wed Nov 24 08:50:08 2010 +0100 +++ b/lisp/gnus/shr.el Wed Nov 24 11:32:22 2010 +0000 @@ -496,18 +496,18 @@ (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.