Mercurial > emacs

comparison lisp/gnus/shr-color.el @ 111683:01aefe45207c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
shr-color.el: fix several function calls. shr.el: replace newline with space in style parsing
author Katsumi Yamaoka <yamaoka@jpl.org>
date Tue, 23 Nov 2010 10:22:49 +0000
parents 3b6c0c4ef2bb
children 1cb16ad0d1bc
comparison
equal deleted inserted replaced
111682:2c6350617cc3 111683:01aefe45207c
52 ;; Is this a number with %? 52 ;; Is this a number with %?
53 (if (eq (elt number string-length) ?%) 53 (if (eq (elt number string-length) ?%)
54 (/ (* (string-to-number (substring number 0 string-length)) 255) 100) 54 (/ (* (string-to-number (substring number 0 string-length)) 255) 100)
55 (string-to-number number)))) 55 (string-to-number number))))
56 56
57 (defun shr-color-hue-to-rgb (x y h)
58 "Convert X Y H to RGB value."
59 (when (< h 0) (incf h))
60 (when (> h 1) (decf h))
61 (cond ((< h (/ 1 6.0)) (+ x (* (- y x) h 6)))
62 ((< h 0.5) y)
63 ((< h (/ 2.0 3.0)) (+ x (* (- y x) (- (/ 2.0 3.0) h) 6)))
64 (t x)))
65
57 (defun shr-color-hsl-to-rgb-fractions (h s l) 66 (defun shr-color-hsl-to-rgb-fractions (h s l)
58 "Convert H S L to fractional RGB values." 67 "Convert H S L to fractional RGB values."
59 (let (m1 m2) 68 (let (m1 m2)
60 (if (<= l 0.5) 69 (if (<= l 0.5)
61 (setq m2 (* l (+ s 1))) 70 (setq m2 (* l (+ s 1)))
62 (setq m2 (- (+ l s) (* l s)))) 71 (setq m2 (- (+ l s) (* l s))))
63 (setq m1 (- (* l 2) m2)) 72 (setq m1 (- (* l 2) m2))
64 (list (rainbow-hue-to-rgb m1 m2 (+ h (/ 1 3.0))) 73 (list (shr-color-hue-to-rgb m1 m2 (+ h (/ 1 3.0)))
65 (rainbow-hue-to-rgb m1 m2 h) 74 (shr-color-hue-to-rgb m1 m2 h)
66 (rainbow-hue-to-rgb m1 m2 (- h (/ 1 3.0)))))) 75 (shr-color-hue-to-rgb m1 m2 (- h (/ 1 3.0))))))
67 76
68 (defun shr-color->hexadecimal (color) 77 (defun shr-color->hexadecimal (color)
69 "Convert any color format to hexadecimal representation. 78 "Convert any color format to hexadecimal representation.
70 Like rgb() or hsl()." 79 Like rgb() or hsl()."
71 (when color 80 (when color
87 color)) 96 color))
88 (let ((h (/ (string-to-number (match-string-no-properties 1 color)) 360.0)) 97 (let ((h (/ (string-to-number (match-string-no-properties 1 color)) 360.0))
89 (s (/ (string-to-number (match-string-no-properties 2 color)) 100.0)) 98 (s (/ (string-to-number (match-string-no-properties 2 color)) 100.0))
90 (l (/ (string-to-number (match-string-no-properties 3 color)) 100.0))) 99 (l (/ (string-to-number (match-string-no-properties 3 color)) 100.0)))
91 (destructuring-bind (r g b) 100 (destructuring-bind (r g b)
92 (rainbow-hsl-to-rgb-fractions h s l) 101 (shr-color-hsl-to-rgb-fractions h s l)
93 (format "#%02X%02X%02X" (* r 255) (* g 255) (* b 255))))) 102 (format "#%02X%02X%02X" (* r 255) (* g 255) (* b 255)))))
94 (t 103 (t
95 color)))) 104 color))))
96 105
97 (defun set-minimum-interval (val1 val2 min max interval &optional fixed) 106 (defun set-minimum-interval (val1 val2 min max interval &optional fixed)