;;; css-color.el --- Highlight and edit CSS colors

(defconst css-color:version "0.03")
;; Copyright (C) 2008  Niels Giesen

;; Author: Niels Giesen
;; Keywords: processes, css, extensions, tools
;; Some smaller changes made by Lennart Borgman

;; Last-Updated: 2009-10-19 Mon

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Edit css-colors in hex, rgb or hsl notation in-place, with
;; immediate feedback by font-locking. Cycle between color-spaces.

;; Usage:

;; (autoload 'css-color-mode "css-color" "" t)
;; (add-hook 'css-mode-hook 'css-color-mode-turn-on)

;; Css-Css-color.el propertizes colours in a CSS stylesheet found by
;; font-locking code with a keymap. From that keymap, you can easily
;; adjust values such as red green and blue, hue, saturation and
;; value, or switch between different color (space) notations.

;; It supports all 'css-colors', so hex, rgb(), hsl() and even HTML
;; color names (although I wouldn't use them myself, it is nice to be
;; able to quickly convert those), can be used and switched between.

;; The rgb() notation can be expressed either in percentages or in
;; values between 0-255.

;; You can cycle between the different formats (with SPACE), so that
;; it is possible to edit the color in hsl mode (which is more
;; intuitive than hsv, although hsv has its merits too), and switch
;; back to rgb or hex if so desired.

;; With point on a color, the keys - and = to are bound to the down
;; and up functions for channels (or 'fields'). Toggling percentage
;; in rgb() is done with the % key (not sure if that is wise
;; though). The TAB key is bound to go to the next channel, cycling
;; when at the end. color.el propertizes the longhand hexcolours
;; found by the

;; Caveats:

;; Notation cycling can often introduce small errors inherent to
;; switching color spaces. Currently there is no check nor a warning
;; for that.

;; ToDo:

;; Try and fix those conversion inaccuracies. This cannot be done
;; completely I guess. But maybe we can check whether this has
;; occured, and then warn.

;;; Change log:

;; 2009-01-11 Lennart Borgman
;;   - Minor code clean up.
;; 2009-05-23 Lennart Borgman
;;   - Let bound m1 and m2.

;;; Code:
(eval-when-compile (require 'cl))
(eval-when-compile (require 'mumamo nil t))

;;;###autoload
(defgroup css-color ()
  "Customization group for library `css-color'."
  :group 'css
  :group 'nxhtml)

(defconst css-color-hex-chars "0123456789abcdefABCDEF"
  "Composing chars in hexadecimal notation, save for the hash (#) sign.")

(defconst css-color-hex-re
  "#\\([a-fA-F[:digit:]]\\{6\\}\\|[a-fA-F[:digit:]]\\{3\\}\\)")

(defconst css-color-hsl-re
  "hsla?(\\([[:digit:]]\\{1,3\\}\\),[[:space:]]*\\([[:digit:]]\\{1,3\\}\\(?:\.?[[:digit:]]*\\)\\)%,[[:space:]]*\\([[:digit:]]\\{1,3\\}\\)\\(?:\.?[[:digit:]]*\\)%)")

(defconst css-color-rgb-re
  "rgba?(\\([[:digit:]]\\{1,3\\}\\(?:\.?[[:digit:]]*%\\)?\\),[[:space:]]*\\([[:digit:]]\\{1,3\\}\\(?:\.?[[:digit:]]*%\\)?\\),[[:space:]]*\\([[:digit:]]\\{1,3\\}\\(?:\.?[[:digit:]]*%\\)?\\)\\(:?,[[:space:]]*\\(0\.[0-9]+\\|1\\)\\)?)")

(defconst css-color-html-colors
  '(("AliceBlue" "#F0F8FF")
    ("AntiqueWhite" "#FAEBD7")
    ("Aqua" "#00FFFF")
    ("Aquamarine" "#7FFFD4")
    ("Azure" "#F0FFFF")
    ("Beige" "#F5F5DC")
    ("Bisque" "#FFE4C4")
    ("Black" "#000000")
    ("BlanchedAlmond" "#FFEBCD")
    ("Blue" "#0000FF")
    ("BlueViolet" "#8A2BE2")
    ("Brown" "#A52A2A")
    ("BurlyWood" "#DEB887")
    ("CadetBlue" "#5F9EA0")
    ("Chartreuse" "#7FFF00")
    ("Chocolate" "#D2691E")
    ("Coral" "#FF7F50")
    ("CornflowerBlue" "#6495ED")
    ("Cornsilk" "#FFF8DC")
    ("Crimson" "#DC143C")
    ("Cyan" "#00FFFF")
    ("DarkBlue" "#00008B")
    ("DarkCyan" "#008B8B")
    ("DarkGoldenRod" "#B8860B")
    ("DarkGray" "#A9A9A9")
    ("DarkGrey" "#A9A9A9")
    ("DarkGreen" "#006400")
    ("DarkKhaki" "#BDB76B")
    ("DarkMagenta" "#8B008B")
    ("DarkOliveGreen" "#556B2F")
    ("Darkorange" "#FF8C00")
    ("DarkOrchid" "#9932CC")
    ("DarkRed" "#8B0000")
    ("DarkSalmon" "#E9967A")
    ("DarkSeaGreen" "#8FBC8F")
    ("DarkSlateBlue" "#483D8B")
    ("DarkSlateGray" "#2F4F4F")
    ("DarkSlateGrey" "#2F4F4F")
    ("DarkTurquoise" "#00CED1")
    ("DarkViolet" "#9400D3")
    ("DeepPink" "#FF1493")
    ("DeepSkyBlue" "#00BFFF")
    ("DimGray" "#696969")
    ("DimGrey" "#696969")
    ("DodgerBlue" "#1E90FF")
    ("FireBrick" "#B22222")
    ("FloralWhite" "#FFFAF0")
    ("ForestGreen" "#228B22")
    ("Fuchsia" "#FF00FF")
    ("Gainsboro" "#DCDCDC")
    ("GhostWhite" "#F8F8FF")
    ("Gold" "#FFD700")
    ("GoldenRod" "#DAA520")
    ("Gray" "#808080")
    ("Grey" "#808080")
    ("Green" "#008000")
    ("GreenYellow" "#ADFF2F")
    ("HoneyDew" "#F0FFF0")
    ("HotPink" "#FF69B4")
    ("IndianRed" "#CD5C5C")
    ("Indigo" "#4B0082")
    ("Ivory" "#FFFFF0")
    ("Khaki" "#F0E68C")
    ("Lavender" "#E6E6FA")
    ("LavenderBlush" "#FFF0F5")
    ("LawnGreen" "#7CFC00")
    ("LemonChiffon" "#FFFACD")
    ("LightBlue" "#ADD8E6")
    ("LightCoral" "#F08080")
    ("LightCyan" "#E0FFFF")
    ("LightGoldenRodYellow" "#FAFAD2")
    ("LightGray" "#D3D3D3")
    ("LightGrey" "#D3D3D3")
    ("LightGreen" "#90EE90")
    ("LightPink" "#FFB6C1")
    ("LightSalmon" "#FFA07A")
    ("LightSeaGreen" "#20B2AA")
    ("LightSkyBlue" "#87CEFA")
    ("LightSlateGray" "#778899")
    ("LightSlateGrey" "#778899")
    ("LightSteelBlue" "#B0C4DE")
    ("LightYellow" "#FFFFE0")
    ("Lime" "#00FF00")
    ("LimeGreen" "#32CD32")
    ("Linen" "#FAF0E6")
    ("Magenta" "#FF00FF")
    ("Maroon" "#800000")
    ("MediumAquaMarine" "#66CDAA")
    ("MediumBlue" "#0000CD")
    ("MediumOrchid" "#BA55D3")
    ("MediumPurple" "#9370D8")
    ("MediumSeaGreen" "#3CB371")
    ("MediumSlateBlue" "#7B68EE")
    ("MediumSpringGreen" "#00FA9A")
    ("MediumTurquoise" "#48D1CC")
    ("MediumVioletRed" "#C71585")
    ("MidnightBlue" "#191970")
    ("MintCream" "#F5FFFA")
    ("MistyRose" "#FFE4E1")
    ("Moccasin" "#FFE4B5")
    ("NavajoWhite" "#FFDEAD")
    ("Navy" "#000080")
    ("OldLace" "#FDF5E6")
    ("Olive" "#808000")
    ("OliveDrab" "#6B8E23")
    ("Orange" "#FFA500")
    ("OrangeRed" "#FF4500")
    ("Orchid" "#DA70D6")
    ("PaleGoldenRod" "#EEE8AA")
    ("PaleGreen" "#98FB98")
    ("PaleTurquoise" "#AFEEEE")
    ("PaleVioletRed" "#D87093")
    ("PapayaWhip" "#FFEFD5")
    ("PeachPuff" "#FFDAB9")
    ("Peru" "#CD853F")
    ("Pink" "#FFC0CB")
    ("Plum" "#DDA0DD")
    ("PowderBlue" "#B0E0E6")
    ("Purple" "#800080")
    ("Red" "#FF0000")
    ("RosyBrown" "#BC8F8F")
    ("RoyalBlue" "#4169E1")
    ("SaddleBrown" "#8B4513")
    ("Salmon" "#FA8072")
    ("SandyBrown" "#F4A460")
    ("SeaGreen" "#2E8B57")
    ("SeaShell" "#FFF5EE")
    ("Sienna" "#A0522D")
    ("Silver" "#C0C0C0")
    ("SkyBlue" "#87CEEB")
    ("SlateBlue" "#6A5ACD")
    ("SlateGray" "#708090")
    ("SlateGrey" "#708090")
    ("Snow" "#FFFAFA")
    ("SpringGreen" "#00FF7F")
    ("SteelBlue" "#4682B4")
    ("Tan" "#D2B48C")
    ("Teal" "#008080")
    ("Thistle" "#D8BFD8")
    ("Tomato" "#FF6347")
    ("Turquoise" "#40E0D0")
    ("Violet" "#EE82EE")
    ("Wheat" "#F5DEB3")
    ("White" "#FFFFFF")
    ("WhiteSmoke" "#F5F5F5")
    ("Yellow" "#FFFF00")
    ("YellowGreen" "#9ACD32")))

(defvar css-color-html-re
  (concat "\\<\\("
	  (funcall 'regexp-opt
		   (mapcar 'car css-color-html-colors))
	  "\\)\\>"))

(defconst
  css-color-color-re
  "\\(?:#\\(?:[a-fA-F[:digit:]]\\{6\\}\\|[a-fA-F[:digit:]]\\{3\\}\\)\\|hsl(\\(?:[[:digit:]]\\{1,3\\}\\),[[:space:]]*\\(?:[[:digit:]]\\{1,3\\}\\)%,[[:space:]]*\\(?:[[:digit:]]\\{1,3\\}\\)%)\\|rgba?(\\(?:[[:digit:]]\\{1,3\\}%?\\),[[:space:]]*\\(?:[[:digit:]]\\{1,3\\}%?\\),[[:space:]]*\\(?:[[:digit:]]\\{1,3\\}%?\\)\\(?:,[[:space:]]*\\(?:0.[0-9]+\\|1\\)\\)?)\\)"
  "Regular expression containing only shy groups matching any type of CSS color")

;; (defconst css-color-color-re
;;   (concat "\\(?1:"
;;   (mapconcat
;;    'identity
;;    (list css-color-hex-re
;; 	 css-color-hsl-re
;; 	 css-color-rgb-re) "\\|")
;;   "\\)"))

(defvar css-color-keywords
  `((,css-color-hex-re
     (0
      (progn
	(when (= 7 (- (match-end 0)
		      (match-beginning 0)))
	  (put-text-property (match-beginning 0)
			     (match-end 0)
			     'keymap css-color-map))
	(put-text-property (match-beginning 0)
			   (match-end 0)
			   'css-color-type 'hex)
	(put-text-property (match-beginning 0)
			   (match-end 0)
			   'rear-nonsticky t)
	(put-text-property (match-beginning 0)
			   (match-end 0)
			   'face (list :background
				       (match-string-no-properties 0)
				       :foreground
				       (css-color-foreground-color
                                        (match-string-no-properties 0)))))))
    (,css-color-html-re
     (0
      (let ((color
             (css-color-string-name-to-hex (match-string-no-properties 0))))
        (put-text-property (match-beginning 0)
                           (match-end 0)
                           'keymap css-color-generic-map)
	(put-text-property (match-beginning 0)
			   (match-end 0)
			   'css-color-type 'name)
	(put-text-property (match-beginning 0)
			   (match-end 0)
			   'rear-nonsticky t)
	(put-text-property (match-beginning 0)
			   (match-end 0)
			   'face (list :background
				       color
				       :foreground
				       (css-color-foreground-color
					color))))))
    (,css-color-hsl-re
     (0
      (let ((color (concat "#" (apply 'css-color-hsl-to-hex
				      (mapcar 'string-to-number
					      (list
					       (match-string-no-properties 1)
					       (match-string-no-properties 2)
					       (match-string-no-properties 3)))))))
	(put-text-property (match-beginning 0)
			   (match-end 0)
			   'keymap css-color-generic-map)
	(put-text-property (match-beginning 0)
			   (match-end 0)
			   'css-color-type 'hsl)
	(put-text-property (match-beginning 0)
			   (match-end 0)
			   'rear-nonsticky t)
	(put-text-property (match-beginning 0)
			   (match-end 0)
			   'face (list :background
				       color
				       :foreground
				       (css-color-foreground-color
					color))))))
    (,css-color-rgb-re
     (0
      (let ((color (css-color-string-rgb-to-hex (match-string-no-properties 0))))
	(put-text-property (match-beginning 0)
			   (match-end 0)
			   'keymap css-color-generic-map)
	(put-text-property (match-beginning 0)
			   (match-end 0)
			   'css-color-type 'rgb)
	(put-text-property (match-beginning 0)
			   (match-end 0)
			   'rear-nonsticky t)
	(put-text-property (match-beginning 0)
			   (match-end 0)
			   'face (list :background
				       color
				       :foreground
				       (css-color-foreground-color
					color))))))))


;;;###autoload
(define-minor-mode css-color-mode
  "Show hex color literals with the given color as background.
In this mode hexadecimal colour specifications like #6600ff are
displayed with the specified colour as background.

Certain keys are bound to special colour editing commands when
point is at a hexadecimal colour:

\\{css-color-map}"
  :initial-value nil
  :group 'css-color
  (unless font-lock-defaults
    (error "Can't use css-color-mode for this major mode"))
  (if css-color-mode
      (progn
	(unless font-lock-mode (font-lock-mode 1))
        (css-color-font-lock-hook-fun)
        (add-hook 'font-lock-mode-hook 'css-color-font-lock-hook-fun nil t))
    (remove-hook 'font-lock-mode-hook 'css-color-font-lock-hook-fun t)
    (font-lock-remove-keywords nil css-color-keywords))
  ;;(font-lock-fontify-buffer)
  (save-restriction
    (widen)
    (mumamo-mark-for-refontification (point-min) (point-max))))

(put 'css-color-mode 'permanent-local t)

(defun css-color-turn-on-in-buffer ()
  "Turn on `css-color-mode' in `css-mode'."
  (when (derived-mode-p 'css-mode)
    (css-color-mode 1)))

;;;###autoload
(define-globalized-minor-mode css-color-global-mode css-color-mode
  css-color-turn-on-in-buffer
  :group 'css-color)

(defun css-color-font-lock-hook-fun ()
  "Add css-color pattern to font-lock's."
  (if font-lock-mode
      (font-lock-add-keywords nil css-color-keywords t)
    (css-color-mode -1)))

(defvar css-color-map
  (let ((m (make-sparse-keymap "css-color")))
    (define-key m "=" 'css-color-up)
    (define-key m "-" 'css-color-down)
    (define-key m "h" 'css-color-hue-up)
    (define-key m "H" 'css-color-hue-down)
    (define-key m "s" 'css-color-saturation-up)
    (define-key m "S" 'css-color-saturation-down)
    (define-key m "v" 'css-color-value-up)
    (define-key m "V" 'css-color-value-down)
    (define-key m "\t" 'css-color-next-channel)
    (define-key m " " 'css-color-cycle-type)
    m)
  "Mode map for `css-color-minor-mode'")

(defvar css-color-generic-map
  (let ((m (make-sparse-keymap "css-color")))
    (define-key m "=" 'css-color-num-up)
    (define-key m "-" 'css-color-num-down)
    (define-key m " " 'css-color-cycle-type)
    (define-key m "%" 'css-color-toggle-percentage)
    (define-key m "\t" 'css-color-next-channel)
    m)
  "Mode map for simple numbers in `css-color-minor-mode'")

(defun css-color-pal-lumsig (r g b)
  "Return PAL luminance signal, but in range 0-255."
  (+
   (* 0.3 r)
   (* 0.59 g)
   (* 0.11 b)))

(defun css-color-foreground-color (hex-color)
  (multiple-value-bind (r g b) (css-color-hex-to-rgb hex-color)
    (if (< (css-color-pal-lumsig r g b) 128)
	"#fff"
      "#000")))

;; Normalizing funs
(defun css-color-normalize-hue (h)
  (mod (+ (mod h 360) 360) 360))

(defun css-color-within-bounds (num min max)
  (min (max min num) max))

;; Source: hex
(defun css-color-hex-to-rgb (str)
  (cond
   ((not (string-match "^#?[a-fA-F[:digit:]]*$" str))
    (error "No valid hexadecimal: %s" str))
   ((= 0 (length str))
    nil)
   ((= (aref str 0) 35)
    (css-color-hex-to-rgb (substring str 1)))
   (;;(oddp (length str))
    (= (mod (length str) 2) 1)
    (css-color-hex-to-rgb (mapconcat (lambda (c)
                                       (make-string 2 c))
                                     (string-to-list str) "")))
   (t (cons (string-to-number (substring str 0 2) 16)
	    (css-color-hex-to-rgb (substring str 2))))))

(defun css-color-hex-to-hsv (hex)
  (multiple-value-bind (r g b) (css-color-hex-to-rgb hex)
    (css-color-rgb-to-hsv r g b)))

;; Source: rgb
(defun css-color-rgb-to-hex (r g b)
  "Return r g b as #rrggbb in hexadecimal, propertized to have
the keymap `css-color-map'"
  (format "%02x%02x%02x" r g b))			     ;val

(defun css-color-rgb-to-hsv (r g b)
  "Return list of (hue saturation value).
Arguments are: R = red; G = green; B = blue.
Measure saturation and value on a scale from 0 - 100.
GIMP-style, that is."
  (let* ((r (float r))
	 (g (float g))
	 (b (float b))
	 (max (max r g b))
	 (min (min r g b)))
    (values
     (round
      (cond ((and (= r g) (= g b)) 0)
            ((and (= r max)
                  (>= g b))
             (* 60 (/ (- g b) (- max min))))
            ((and (= r max)
                  (< g b))
             (+ 360 (* 60 (/ (- g b) (- max min)))))
            ((= max g)
             (+ 120 (* 60 (/ (- b r) (- max min)))))
            ((= max b)
             (+ 240 (* 60 (/ (- r g) (- max min)))))))  ;hue
     (round (* 100 (if (= max 0) 0 (- 1 (/ min max))))) ;sat
     (round (/ max 2.55)))))

(defun css-color-rgb-to-hsl (r g b)
  "Return R G B (in range 0-255) converted to HSL (0-360 for hue, rest in %)"
  (let* ((r (/ r 255.0))
	 (g (/ g 255.0))
	 (b (/ b 255.0))
	 (h 0)
	 (s 0)
	 (l 0)
	 (v (max r g b))
	 (m (min r g b))
	 (l (/ (+ m v) 2.0))
	 (vm 0)
	 (r2 0)
	 (g2 0)
	 (b2 0))
    (multiple-value-bind (h s v)
	(if (<= l 0)
	    (values h s l)
	  (setq vm (- v m)
		s vm)
	  (if (>= 0 s)
	      (values h s l)
	    (setq s (/ s (if (<= l 0.5)
			     (+ v m)
			   (- 2.0 v m))))
	    (if (not (= 0 vm))
		(setq r2 (/ (- v r) vm)
		      g2 (/ (- v g) vm)
		      b2 (/ (- v b) vm)))
	    (cond ((= r v)
		   (setq h (if (= g m)
			       (+ 5.0 b2)
			     (- 1.0 g2))))
		  ((= g v)
		   (setq h (if (= b m)
			       (+ 1.0 r2)
			     (- 3.0 b2))))
		  (t
		   (setq h (if (= r m)
			       (+ 3.0 g2)
			     (- 5.0 r2)))))
	    (values (/ h 6.0) s l)))
      (list (round(* 360 h))
	    (* 100 s)
	    (* 100 l)))))

;; Source: hsv
(defun css-color-hsv-to-hsl (h s v)
  (multiple-value-bind (r g b) (css-color-hsv-to-rgb h s v)
    (css-color-rgb-to-hsl r g b)))

(defun css-color-hsv-to-hex (h s v)
  (apply 'css-color-rgb-to-hex (css-color-hsv-to-rgb h s v)))

(defun css-color-hsv-to-rgb (h s v)
  "Convert a point in the Hue, Saturation, Value (aka Brightness)
color space to list of normalized Red, Green, Blue values.

HUE is an angle in the range of 0 degrees inclusive to 360
exclusive.  The remainder of division by 360 is used for
out-of-range values.
SATURATION is in the range of 0 to 100.
VALUE is in the range of 0 to 100.
Returns a list of values in the range of 0 to 255.
"
  ;; Coerce to float and get hue into range.
  (setq h (mod h 360.0)
        s (/ (float s) 100)
        v (/ (float v) 100))
  (let* ((hi (floor h 60.0))
         (f (- (/ h 60.0) hi))
         (p (* v (- 1.0 s)))
         (q (* v (- 1.0 (* f s))))
         ;; cannot use variable t, obviously.
         (u (* v (- 1.0 (* (- 1.0 f) s))))
         r g b)
    (case hi
      (0 (setq r v g u b p))
      (1 (setq r q g v b p))
      (2 (setq r p g v b u))
      (3 (setq r p g q b v))
      (4 (setq r u g p b v))
      (5 (setq r v g p b q)))
    (mapcar (lambda (color) (round (* 255 color))) (list r g b))))

(defun css-color-hsv-to-prop-hexstring (color-data)
  (propertize
   (apply 'css-color-hsv-to-hex color-data)
   'keymap css-color-map
   'css-color color-data))

;; Source: hsl
(defun css-color-hsl-to-rgb-fractions (h s l)
  (let (m1 m2)
    (if (<= l 0.5)
	(setq m2 (* l (+ s 1)))
      (setq m2 (- (+ l s) (* l s))))
    (setq m1 (- (* l 2) m2))
    (values (css-color-hue-to-rgb m1 m2 (+ h (/ 1 3.0)))
	    (css-color-hue-to-rgb m1 m2 h)
	    (css-color-hue-to-rgb m1 m2 (- h (/ 1 3.0))))))

(defun css-color-hsl-to-rgb (h s l)
  (multiple-value-bind (r g b)
      (css-color-hsl-to-rgb-fractions
       (/ h;; (css-color-normalize-hue h)
	  360.0)
       (/ s 100.0)
       (/ l 100.0))
    (values (css-color-within-bounds (* 256 r) 0 255)
	    (css-color-within-bounds (* 256 g) 0 255)
	    (css-color-within-bounds (* 256 b) 0 255))))

(defun css-color-hsl-to-hex (h s l)
  (apply 'css-color-rgb-to-hex
	 (css-color-hsl-to-rgb h s l)))

(defun css-color-hue-to-rgb (x y h)
  (when (< h 0) (incf h))
  (when (> h 1) (decf h))
  (cond ((< h (/ 1 6.0))
         (+ x (* (- y x) h 6)))
        ((< h 0.5) y)
        ((< h (/ 2.0 3.0))
         (+ x (* (- y x) (- (/ 2.0 3.0) h) 6)))
        (t x)))

(defun css-color-parse-hsl (str)
  (string-match
   css-color-hsl-re
   str)
  (mapcar 'string-to-number
	  (list
	   (match-string 1 str)
	   (match-string 2 str)
	   (match-string 3 str))))

(defun css-color-inchue (color incr)
  (multiple-value-bind (h s v) color
    (css-color-hsv-to-prop-hexstring
     (list (+ incr h) s v))))

(defun css-color-incsat (color incr)
  (multiple-value-bind (h s v) color
    (css-color-hsv-to-prop-hexstring
     (list h (css-color-within-bounds (+ incr s) 0 100) v))))

(defun css-color-incval (color incr)
  (multiple-value-bind (h s v) color
    (css-color-hsv-to-prop-hexstring
     (list h s (css-color-within-bounds (+ incr v) 0 100)))))

(defun css-color-hexval-beginning ()
  (skip-chars-backward css-color-hex-chars)
  (if (= (char-after) 35)
      (forward-char 1)))

(defun css-color-replcolor-at-p (fun increment)
  (let ((pos (point)))
    (css-color-hexval-beginning)
    (insert
     (funcall fun
	      (css-color-get-color-at-point)
	      increment))
    (delete-region (point) (+ (point) 6))
    (goto-char pos)))

(defun css-color-get-color-at-point ()
  (save-excursion
    (css-color-hexval-beginning)
    (let ((saved-color (get-text-property (point) 'css-color)))
      (or saved-color
	  (css-color-hex-to-hsv
	   (buffer-substring-no-properties (point) (+ (point) 6)))))))

(defun css-color-adj-hue-at-p (increment)
  (interactive "p")
  (css-color-replcolor-at-p 'css-color-inchue increment))

(defun css-color-adj-saturation-at-p (increment)
  (interactive "p")
  (css-color-replcolor-at-p 'css-color-incsat increment))

(defun css-color-adj-value-at-p (increment)
  (interactive "p")
  (css-color-replcolor-at-p 'css-color-incval increment))

(defun css-color-what-channel ()
  (let ((pos (point)))
    (prog1
	(/ (skip-chars-backward css-color-hex-chars) -2)
      (goto-char pos))))

(defun css-color-adjust-hex-at-p (incr)
  (interactive "p")
  (let ((pos (point))
	(channel (css-color-what-channel)))
    (css-color-hexval-beginning)
    (let ((rgb
	   (css-color-hex-to-rgb
	    (buffer-substring-no-properties (point)
					    (+ 6 (point))))))
      (setf (nth channel rgb)
	    (css-color-within-bounds
	     (+ incr (nth channel rgb))
	     0 255))
      (delete-region (point) (+ 6 (point)))
      (insert
       (propertize
	(apply 'format "%02x%02x%02x" rgb)
	'keymap css-color-map
	'css-color nil
	'rear-nonsticky t)))
    (goto-char pos)))

;; channels (r, g, b)
(defun css-color-up (val)
  "Adjust R/G/B up."
  (interactive "p")
  (css-color-adjust-hex-at-p val))

(defun css-color-down (val)
  "Adjust R/G/B down."
  (interactive "p")
  (css-color-adjust-hex-at-p (- val)))
;; hue
(defun css-color-hue-up (val)
  "Adjust Hue up."
  (interactive "p")
  (css-color-adj-hue-at-p val))

(defun css-color-hue-down (val)
  "Adjust Hue down."
  (interactive "p")
  (css-color-adj-hue-at-p (- val)))
;; saturation
(defun css-color-saturation-up (val)
  "Adjust Saturation up."
  (interactive "p")
  (css-color-adj-saturation-at-p val))

(defun css-color-saturation-down (val)
  "Adjust Saturation down."
  (interactive "p")
  (css-color-adj-saturation-at-p (- val)))
;; value
(defun css-color-value-up (val)
  "Adjust Value up."
  (interactive "p")
  (css-color-adj-value-at-p val))

(defun css-color-value-down (val)
  "Adjust Value down."
  (interactive "p")
  (css-color-adj-value-at-p (- val)))

(defun css-color-num-up (arg)
  "Adjust HEX number up."
  (interactive "p")
  (save-excursion
    (let ((digits "1234567890"))
      (skip-chars-backward digits)
      (when
	  (looking-at "[[:digit:]]+")
	(replace-match
	 (propertize
	  (let ((num (+ (string-to-number (match-string 0)) arg)))
					;max = 100 when at percentage
	    (save-match-data
	      (cond ((looking-at "[[:digit:]]+%")
		     (setq num (min num 100)))
		    ((looking-back "hsla?(")
		     (setq num (css-color-normalize-hue num)))
		    ((memq 'css-color-type (text-properties-at (point)))
		     (setq num (min num 255)))))
	    (number-to-string num))
	  'keymap
	  css-color-generic-map))))))

(defun css-color-num-down (arg)
  "Adjust HEX number down."
  (interactive "p")
  (save-excursion
    (let ((digits "1234567890"))
      (skip-chars-backward digits)
      (when
	  (looking-at "[[:digit:]]+")
	(replace-match
	 (propertize
	  (let ((num (- (string-to-number (match-string 0)) arg)))
					;max = 100 when at percentage
	    (save-match-data
	      (cond ((looking-back "hsla?(")
		     (setq num (css-color-normalize-hue num)))
		    (t (setq num (max 0 num)))))
	    (number-to-string num))
	  'keymap css-color-generic-map))))))


(defun css-color-beginning-of-color ()
  "Skip to beginning of color.

Return list of point and color-type."
  (while (memq 'css-color-type (text-properties-at (point)))
    (backward-char 1))
  (forward-char 1)
  (cons (point) (plist-get (text-properties-at (point)) 'css-color-type)))

(defun css-color-end-of-color ()
  "Skip to beginning of color.

Return list of point and color-type."
  (while (plist-get (text-properties-at (point)) 'css-color-type)
    (forward-char 1))
  (cons (point) (plist-get (text-properties-at (1- (point))) 'css-color-type)))

(defun css-color-color-info ()
  (destructuring-bind ((beg . type)
		       (end . type))
      (list
       (css-color-beginning-of-color)
       (css-color-end-of-color))
    (list beg end type (buffer-substring-no-properties beg end))))

(defconst css-color-type-circle '#1=(hex hsl rgb name . #1#))

(defun css-color-next-type (sym)
  (cadr (member sym css-color-type-circle)))

(defun css-color-cycle-type ()
  "Cycle color type."
  (interactive)
  (destructuring-bind (beg end type color) (css-color-color-info)
    (if (or (= 0 (length color)) (null type))
	(error "Not at color"))
    (delete-region beg end)
    (insert
     (propertize (funcall
                  (intern-soft (format "css-color-string-%s-to-%s"
                                       type
                                       (css-color-next-type type)))
                  color)
                 'keymap (if (eq (css-color-next-type type) 'hex)
                             css-color-map
                           css-color-generic-map)     'rear-nonsticky t))
    (goto-char beg)))

(defun css-color-string-hex-to-hsl (str)
  (multiple-value-bind (h s l)
      (apply 'css-color-rgb-to-hsl
	     (css-color-hex-to-rgb str))
    (format "hsl(%d,%d%%,%d%%)"
	    h s l)))

(defun css-color-string-hsl-to-rgb (str)
  (multiple-value-bind (h s l)
      (css-color-parse-hsl str)
    (apply 'format
           "rgb(%d,%d,%d)"
           (mapcar 'round (css-color-hsl-to-rgb h s l)))))

(defun css-color-string-rgb-to-name (str)
  (let ((color (css-color-string-rgb-to-hex str)))
    (or (car (rassoc (list (upcase color)) css-color-html-colors)) ;if name ok
        color)))                                  ;else return hex

(defun css-color-string-name-to-hex (str)
  (let ((str (downcase str)))
    (cadr (assoc-if
           (lambda (a)
             (string=
              (downcase a)
              str))
	   css-color-html-colors))))

(defun css-color-string-rgb-to-hex (str)
  (save-match-data
    (string-match css-color-rgb-re str)
    (concat "#"
	    (apply 'css-color-rgb-to-hex
		   (mapcar
		    ;;'string-to-number
		    (lambda (s)
		      (if (= (aref s (1- (length s))) ?\%)
			  (round (* (string-to-number s) 2.55))
			(string-to-number s)))
		    (list
		     (match-string-no-properties 1 str)
		     (match-string-no-properties 2 str)
		     (match-string-no-properties 3 str)))))))

(defun css-color-string-hsl-to-hex (str)
  (concat "#" (apply 'css-color-hsl-to-hex (css-color-parse-hsl str))))

(defun css-color-next-channel ()
  "Cycle color channel."
  (interactive)
  (multiple-value-bind (beg end type color)
      (save-excursion (css-color-color-info))
    (case type
      ((hsl rgb)
       (if (not (re-search-forward ",\\|(" end t))
	   (goto-char (+ beg 4))))
      (hex
       (cond ((> (point) (- end 3))
	      (goto-char (+ 1 beg)))
	     ((= (char-after) 35)
	      (forward-char 1))
	     ((evenp (- (point) beg))
	      (forward-char 1))
	     (t (forward-char 2)))))))

(defun css-color-hexify-anystring (str)
  (cond ((string-match "^hsl" str)
	 (css-color-string-hsl-to-hex str))
	((string-match "^rgb" str)
	 (css-color-string-rgb-to-hex str))
	(t str)))

(defun css-color-toggle-percentage ()
  "Toggle percent ??"
  (interactive)
  (let ((pos (point)))
    (if (eq (nth 2 (save-excursion (css-color-color-info))) 'rgb)
	(let ((chars "%1234567890."))
	  (skip-chars-backward chars)
	  (when
	      (looking-at "[[:digit:]]+\\(?:\.?[[:digit:]]*%\\)?%?")
	    (let ((s (match-string 0)))
	      (replace-match
	       (propertize
		(if (= (aref s (1- (length s))) ?\%)
		    (number-to-string (round (* (string-to-number s) 2.55)))
		  (format "%d%%" (/ (string-to-number s) 2.55)))
		'keymap css-color-generic-map
		'rear-nonsticky t)))
	    ;;(goto-char pos)
	    ))
      (message "No toggling at point."))))

;; provide some backwards-compatibility to hexcolor.el:
(defvar css-color-fg-history nil)
(defvar css-color-bg-history nil)

;;;###autoload
(defun css-color-test (fg-color bg-color)
  "Test colors interactively.
The colors are displayed in the echo area. You can specify the
colors as any viable css color.  Example:

  red
  #f00
  #0C0
  #b0ff00
  hsla(100, 50%, 25%)
  rgb(255,100,120)"
  (interactive (list (completing-read "Foreground color: "
				      css-color-html-colors
				      nil nil nil nil css-color-fg-history)
		     (completing-read "Background color: "
				      css-color-html-colors
				      nil nil nil nil css-color-bg-history)))
  (let* ((s (concat " Foreground: " fg-color ", Background: " bg-color " ")))
    (put-text-property 0 (length s)
                       'face (list
                              :foreground (css-color-hexify-anystring fg-color)
                              :background (css-color-hexify-anystring bg-color))
                       s)
    (message "Here are the colors: %s" s)))

(defun css-color-run-tests ()
  (interactive)
  (unless
      (progn
	(assert
	 (string= (css-color-string-hex-to-hsl "#ffff00") "hsl(60,100%,50%)"))
	(assert
	 (string= (css-color-string-rgb-to-hex "rgb(255, 50%,   0)")"#ff7f00"))
	(assert
	 (string= (css-color-string-hsl-to-rgb "hsl(60, 100%, 50%)") "rgb(255,255,0)"))
	(assert
	 (string= (css-color-string-hsl-to-hex "hsl(60, 100%, 50%)") "#ffff00")))
    (message "All tests passed")))

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