gnus-art.el (gnus-mime-buttonize-attachments-in-header): Improve criterion that finds...

[gnus] / lisp / color.el

diff --git a/lisp/color.el b/lisp/color.el
index fc306f5..8c692c4 100644 (file)
--- a/lisp/color.el
+++ b/lisp/color.el
@@ -1,6 +1,6 @@
 ;;; color.el --- Color manipulation library -*- coding: utf-8; -*-
 
 ;;; color.el --- Color manipulation library -*- coding: utf-8; -*-
 

-;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.

 
 ;; Authors: Julien Danjou <julien@danjou.info>
 ;;          Drew Adams <drew.adams@oracle.com>
 
 ;; Authors: Julien Danjou <julien@danjou.info>
 ;;          Drew Adams <drew.adams@oracle.com>


@@ -33,9 +33,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile
-  (require 'cl))
-

 ;; Emacs < 23.3
 (eval-and-compile
   (unless (boundp 'float-pi)
 ;; Emacs < 23.3
 (eval-and-compile
   (unless (boundp 'float-pi)


@@ -50,17 +47,17 @@ string (e.g. \"#ff12ec\").
 Normally the return value is a list of three floating-point
 numbers, (RED GREEN BLUE), each between 0.0 and 1.0 inclusive.
 
 Normally the return value is a list of three floating-point
 numbers, (RED GREEN BLUE), each between 0.0 and 1.0 inclusive.
 

-Optional arg FRAME specifies the frame where the color is to be
+Optional argument FRAME specifies the frame where the color is to be

 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
 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.
+  ;; display system.  So we use a white conversion to get the max value.

   (let ((valmax (float (car (color-values "#ffffff")))))
     (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.
   (let ((valmax (float (car (color-values "#ffffff")))))
     (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 BLUE must be numbers between 0.0 and 1.0 inclusive."
+RED, GREEN, and BLUE should be numbers between 0.0 and 1.0, inclusive."

   (format "#%02x%02x%02x"
           (* red 255) (* green 255) (* blue 255)))
 
   (format "#%02x%02x%02x"
           (* red 255) (* green 255) (* blue 255)))
 


@@ -69,14 +66,14 @@ RED GREEN BLUE must be numbers between 0.0 and 1.0 inclusive."
 COLOR-NAME should be a string naming a color (e.g. \"white\"), or
 a string specifying a color's RGB components (e.g. \"#ff12ec\")."
   (let ((color (color-name-to-rgb color-name)))
 COLOR-NAME should be a string naming a color (e.g. \"white\"), or
 a string specifying a color's RGB components (e.g. \"#ff12ec\")."
   (let ((color (color-name-to-rgb color-name)))

-    (list (- 1.0 (car color))
-          (- 1.0 (cadr color))
-          (- 1.0 (caddr color)))))
+    (list (- 1.0 (nth 0 color))
+          (- 1.0 (nth 1 color))
+          (- 1.0 (nth 2 color)))))

 
 (defun color-gradient (start stop step-number)
   "Return a list with STEP-NUMBER colors from START to STOP.
 The color list builds a color gradient starting at color START to
 
 (defun color-gradient (start stop step-number)
   "Return a list with STEP-NUMBER colors from START to STOP.
 The color list builds a color gradient starting at color START to

-color STOP. It does not include the START and STOP color in the
+color STOP.  It does not include the START and STOP color in the

 resulting list."
   (let* ((r (nth 0 start))
         (g (nth 1 start))
 resulting list."
   (let* ((r (nth 0 start))
         (g (nth 1 start))


@@ -92,14 +89,39 @@ resulting list."
            result))
     (nreverse result)))
 
            result))
     (nreverse result)))
 

+(defun color-hue-to-rgb (v1 v2 h)
+  "Compute hue from V1 and V2 H.
+Used internally by `color-hsl-to-rgb'."
+  (cond
+   ((< h (/ 1.0 6))   (+ v1 (* (- v2 v1) h 6.0)))
+   ((< h 0.5)         v2)
+   ((< h (/ 2.0 3))   (+ v1 (* (- v2 v1) (- (/ 2.0 3) h) 6.0)))
+   (t                 v1)))
+
+(defun color-hsl-to-rgb (H S L)
+  "Convert hue, saturation and luminance to their RGB representation.
+H, S, and L should each be numbers between 0.0 and 1.0, inclusive.
+Return a list (RED GREEN BLUE), where each element is between 0.0 and 1.0,
+inclusive."
+  (if (= S 0.0)
+      (list L L L)
+    (let* ((m2 (if (<= L 0.5)
+                  (* L (+ 1.0 S))
+                (- (+ L S) (* L S))))
+          (m1 (- (* 2.0 L) m2)))
+      (list
+       (color-hue-to-rgb m1 m2 (mod (+ H (/ 1.0 3)) 1))
+       (color-hue-to-rgb m1 m2 H)
+       (color-hue-to-rgb m1 m2 (mod (- H (/ 1.0 3)) 1))))))
+

 (defun color-complement-hex (color)
   "Return the color that is the complement of COLOR, in hexadecimal format."
   (apply 'color-rgb-to-hex (color-complement color)))
 
 (defun color-rgb-to-hsv (red green blue)
 (defun color-complement-hex (color)
   "Return the color that is the complement of COLOR, in hexadecimal format."
   (apply 'color-rgb-to-hex (color-complement color)))
 
 (defun color-rgb-to-hsv (red green blue)

-  "Convert RED, GREEN, and BLUE color components to HSV.
+  "Convert RGB color components to HSV.

 RED, GREEN, and BLUE should each be numbers between 0.0 and 1.0,
 RED, GREEN, and BLUE should each be numbers between 0.0 and 1.0,

-inclusive.  Return a list (HUE, SATURATION, VALUE), where HUE is
+inclusive.  Return a list (HUE SATURATION VALUE), where HUE is

 in radians and both SATURATION and VALUE are between 0.0 and 1.0,
 inclusive."
   (let* ((r (float red))
 in radians and both SATURATION and VALUE are between 0.0 and 1.0,
 inclusive."
   (let* ((r (float red))


@@ -108,7 +130,7 @@ inclusive."
         (max (max r g b))
         (min (min r g b)))
     (if (< (- max min) 1e-8)
         (max (max r g b))
         (min (min r g b)))
     (if (< (- max min) 1e-8)

-       (list 0.0 0.0 0.0)
+       (list 0.0 0.0 min)

       (list
        (/ (* 2 float-pi
             (cond ((and (= r g) (= g b)) 0)
       (list
        (/ (* 2 float-pi
             (cond ((and (= r g) (= g b)) 0)


@@ -124,16 +146,13 @@ inclusive."
                    (+ 240 (* 60 (/ (- r g) (- max min)))))))
          360)
        (if (= max 0) 0 (- 1 (/ min max)))
                    (+ 240 (* 60 (/ (- r g) (- max min)))))))
          360)
        (if (= max 0) 0 (- 1 (/ min max)))

-       (/ max 255.0)))))
+       max))))

 
 (defun color-rgb-to-hsl (red green blue)
 
 (defun color-rgb-to-hsl (red green blue)

-  "Convert RED GREEN BLUE colors to their HSL representation.
+  "Convert RGB colors to their HSL representation.

 RED, GREEN, and BLUE should each be numbers between 0.0 and 1.0,
 RED, GREEN, and BLUE should each be numbers between 0.0 and 1.0,

-inclusive.
-
-Return a list (HUE, SATURATION, LUMINANCE), where HUE is in radians
-and both SATURATION and LUMINANCE are between 0.0 and 1.0,
-inclusive."
+inclusive.  Return a list (HUE SATURATION LUMINANCE), where
+each element is between 0.0 and 1.0, inclusive."

   (let* ((r red)
          (g green)
          (b blue)
   (let* ((r red)
          (g green)
          (b blue)


@@ -159,7 +178,7 @@ inclusive."
 
 (defun color-srgb-to-xyz (red green blue)
   "Convert RED GREEN BLUE colors from the sRGB color space to CIE XYZ.
 
 (defun color-srgb-to-xyz (red green blue)
   "Convert RED GREEN BLUE colors from the sRGB color space to CIE XYZ.

-RED, BLUE and GREEN must be between 0 and 1, inclusive."
+RED, GREEN and BLUE should be between 0.0 and 1.0, inclusive."

   (let ((r (if (<= red 0.04045)
                (/ red 12.95)
              (expt (/ (+ red 0.055) 1.055) 2.4)))
   (let ((r (if (<= red 0.04045)
                (/ red 12.95)
              (expt (/ (+ red 0.055) 1.055) 2.4)))


@@ -197,7 +216,7 @@ RED, BLUE and GREEN must be between 0 and 1, inclusive."
 (defun color-xyz-to-lab (X Y Z &optional white-point)
   "Convert CIE XYZ to CIE L*a*b*.
 WHITE-POINT specifies the (X Y Z) white point for the
 (defun color-xyz-to-lab (X Y Z &optional white-point)
   "Convert CIE XYZ to CIE L*a*b*.
 WHITE-POINT specifies the (X Y Z) white point for the

-conversion. If omitted or nil, use `color-d65-xyz'."
+conversion.  If omitted or nil, use `color-d65-xyz'."

   (destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz)
       (let* ((xr (/ X Xr))
              (yr (/ Y Yr))
   (destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz)
       (let* ((xr (/ X Xr))
              (yr (/ Y Yr))


@@ -219,7 +238,7 @@ conversion. If omitted or nil, use `color-d65-xyz'."
 (defun color-lab-to-xyz (L a b &optional white-point)
   "Convert CIE L*a*b* to CIE XYZ.
 WHITE-POINT specifies the (X Y Z) white point for the
 (defun color-lab-to-xyz (L a b &optional white-point)
   "Convert CIE L*a*b* to CIE XYZ.
 WHITE-POINT specifies the (X Y Z) white point for the

-conversion. If omitted or nil, use `color-d65-xyz'."
+conversion.  If omitted or nil, use `color-d65-xyz'."

   (destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz)
       (let* ((fy (/ (+ L 16) 116.0))
              (fz (- fy (/ b 200.0)))
   (destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz)
       (let* ((fy (/ (+ L 16) 116.0))
              (fz (- fy (/ b 200.0)))


@@ -311,6 +330,70 @@ returned by `color-srgb-to-lab' or `color-xyz-to-lab'."
                  (expt (/ ΔH′ (* Sh kH)) 2.0)
                  (* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH)))))))))
 
                  (expt (/ ΔH′ (* Sh kH)) 2.0)
                  (* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH)))))))))
 

+(defun color-clamp (value)
+  "Make sure VALUE is a number between 0.0 and 1.0 inclusive."
+  (min 1.0 (max 0.0 value)))
+
+(defun color-saturate-hsl (H S L percent)
+  "Make a color more saturated by a specified amount.
+Given a color defined in terms of hue, saturation, and luminance
+\(arguments H, S, and L), return a color that is PERCENT more
+saturated.  Returns a list (HUE SATURATION LUMINANCE)."
+  (list H (color-clamp (+ S (/ percent 100.0))) L))
+
+(defun color-saturate-name (name percent)
+  "Make a color with a specified NAME more saturated by PERCENT.
+See `color-saturate-hsl'."
+  (apply 'color-rgb-to-hex
+        (apply 'color-hsl-to-rgb
+               (apply 'color-saturate-hsl
+                      (append
+                       (apply 'color-rgb-to-hsl
+                              (color-name-to-rgb name))
+                       (list percent))))))
+
+(defun color-desaturate-hsl (H S L percent)
+  "Make a color less saturated by a specified amount.
+Given a color defined in terms of hue, saturation, and luminance
+\(arguments H, S, and L), return a color that is PERCENT less
+saturated.  Returns a list (HUE SATURATION LUMINANCE)."
+  (color-saturate-hsl H S L (- percent)))
+
+(defun color-desaturate-name (name percent)
+  "Make a color with a specified NAME less saturated by PERCENT.
+See `color-desaturate-hsl'."
+  (color-saturate-name name (- percent)))
+
+(defun color-lighten-hsl (H S L percent)
+  "Make a color lighter by a specified amount.
+Given a color defined in terms of hue, saturation, and luminance
+\(arguments H, S, and L), return a color that is PERCENT lighter.
+Returns a list (HUE SATURATION LUMINANCE)."
+  (list H S (color-clamp (+ L (/ percent 100.0)))))
+
+(defun color-lighten-name (name percent)
+  "Make a color with a specified NAME lighter by PERCENT.
+See `color-lighten-hsl'."
+  (apply 'color-rgb-to-hex
+        (apply 'color-hsl-to-rgb
+               (apply 'color-lighten-hsl
+                      (append
+                       (apply 'color-rgb-to-hsl
+                              (color-name-to-rgb name))
+                       (list percent))))))
+
+(defun color-darken-hsl (H S L percent)
+    "Make a color darker by a specified amount.
+Given a color defined in terms of hue, saturation, and luminance
+\(arguments H, S, and L), return a color that is PERCENT darker.
+Returns a list (HUE SATURATION LUMINANCE)."
+  (color-lighten-hsl H S L (- percent)))
+
+(defun color-darken-name (name percent)
+  "Make a color with a specified NAME darker by PERCENT.
+See `color-darken-hsl'."
+  (color-lighten-name name (- percent)))
+

 (provide 'color)
 
 ;;; color.el ends here
 (provide 'color)
 
 ;;; color.el ends here