[Emacs-diffs] master 7b00e95: Fix color component calculations in color.el

[Eli Zaretskii]

branch: master
commit 7b00e956b485d8ade03c870cbdd0ae086348737b
Author: Eli Zaretskii <address@hidden>
Commit: Eli Zaretskii <address@hidden>

    Fix color component calculations in color.el
    
    * lisp/color.el (color-name-to-rgb): Use 16 bits per color component.
    (color-rgb-to-hex): Accept an optional argument
    DIGITS-PER-COMPONENT, defaulting to 4, and format the hexadecimal
    notation either for 8 or 16 bits per component.  (Bug#25890)
    * lisp/net/shr-color.el (shr-color->hexadecimal): Call
    color-rgb-to-hex with the optional argument of 2, to match color
    processing on the Web.
---
 lisp/color.el         | 16 ++++++++++------
 lisp/net/shr-color.el |  2 +-
 2 files changed, 11 insertions(+), 7 deletions(-)

diff --git a/lisp/color.el b/lisp/color.el
index 32c8127..6dbf3d5 100644
--- a/lisp/color.el
+++ b/lisp/color.el
@@ -52,14 +52,18 @@ displayed.  If FRAME is omitted or nil, use the selected 
frame.
 If FRAME cannot display COLOR, return nil."
   ;; `colors-values' maximum value is either 65535 or 65280 depending on the
   ;; display system.  So we use a white conversion to get the max value.
-  (let ((valmax (float (car (color-values "#ffffff")))))
+  (let ((valmax (float (car (color-values "#ffffffffffff")))))
     (mapcar (lambda (x) (/ x valmax)) (color-values color frame))))
 
-(defun color-rgb-to-hex  (red green blue)
-  "Return hexadecimal notation for the color RED GREEN BLUE.
-RED, GREEN, and BLUE should be numbers between 0.0 and 1.0, inclusive."
-  (format "#%02x%02x%02x"
-          (* red 255) (* green 255) (* blue 255)))
+(defun color-rgb-to-hex  (red green blue &optional digits-per-component)
+  "Return hexadecimal #RGB notation for the color specified by RED GREEN BLUE.
+RED, GREEN, and BLUE should be numbers between 0.0 and 1.0, inclusive.
+Optional argument DIGITS-PER-COMPONENT can be either 4 (the default)
+or 2; use the latter if you need a 24-bit specification of a color."
+  (or digits-per-component (setq digits-per-component 4))
+  (let* ((maxval (if (= digits-per-component 2) 255 65535))
+         (fmt (if (= digits-per-component 2) "#%02x%02x%02x" "#%04x%04x%04x")))
+    (format fmt (* red maxval) (* green maxval) (* blue maxval))))
 
 (defun color-complement (color-name)
   "Return the color that is the complement of COLOR-NAME.
diff --git a/lisp/net/shr-color.el b/lisp/net/shr-color.el
index cb081cb..b0c706e 100644
--- a/lisp/net/shr-color.el
+++ b/lisp/net/shr-color.el
@@ -260,7 +260,7 @@ 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)
-          (color-rgb-to-hex r g b))))
+          (color-rgb-to-hex r g b 2))))
      ;; Color names
      ((cdr (assoc-string color shr-color-html-colors-alist t)))
      ;; Unrecognized color :(