1 ;;; css-color.el --- Highlight and edit CSS colors
3 (defconst css-color:version "0.03")
4 ;; Copyright (C) 2008 Niels Giesen
6 ;; Author: Niels Giesen
7 ;; Keywords: processes, css, extensions, tools
8 ;; Some smaller changes made by Lennart Borgman
10 ;; Last-Updated: 2009-10-19 Mon
12 ;; This program is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
27 ;; Edit css-colors in hex, rgb or hsl notation in-place, with
28 ;; immediate feedback by font-locking. Cycle between color-spaces.
32 ;; (autoload 'css-color-mode "css-color" "" t)
33 ;; (add-hook 'css-mode-hook 'css-color-mode-turn-on)
35 ;; Css-Css-color.el propertizes colours in a CSS stylesheet found by
36 ;; font-locking code with a keymap. From that keymap, you can easily
37 ;; adjust values such as red green and blue, hue, saturation and
38 ;; value, or switch between different color (space) notations.
40 ;; It supports all 'css-colors', so hex, rgb(), hsl() and even HTML
41 ;; color names (although I wouldn't use them myself, it is nice to be
42 ;; able to quickly convert those), can be used and switched between.
44 ;; The rgb() notation can be expressed either in percentages or in
45 ;; values between 0-255.
47 ;; You can cycle between the different formats (with SPACE), so that
48 ;; it is possible to edit the color in hsl mode (which is more
49 ;; intuitive than hsv, although hsv has its merits too), and switch
50 ;; back to rgb or hex if so desired.
52 ;; With point on a color, the keys - and = to are bound to the down
53 ;; and up functions for channels (or 'fields'). Toggling percentage
54 ;; in rgb() is done with the % key (not sure if that is wise
55 ;; though). The TAB key is bound to go to the next channel, cycling
56 ;; when at the end. color.el propertizes the longhand hexcolours
61 ;; Notation cycling can often introduce small errors inherent to
62 ;; switching color spaces. Currently there is no check nor a warning
67 ;; Try and fix those conversion inaccuracies. This cannot be done
68 ;; completely I guess. But maybe we can check whether this has
69 ;; occured, and then warn.
73 ;; 2009-01-11 Lennart Borgman
74 ;; - Minor code clean up.
75 ;; 2009-05-23 Lennart Borgman
76 ;; - Let bound m1 and m2.
79 (eval-when-compile (require 'cl))
80 (eval-when-compile (require 'mumamo nil t))
83 (defgroup css-color ()
84 "Customization group for library `css-color'."
88 (defconst css-color-hex-chars "0123456789abcdefABCDEF"
89 "Composing chars in hexadecimal notation, save for the hash (#) sign.")
91 (defconst css-color-hex-re
92 "#\\([a-fA-F[:digit:]]\\{6\\}\\|[a-fA-F[:digit:]]\\{3\\}\\)")
94 (defconst css-color-hsl-re
95 "hsla?(\\([[:digit:]]\\{1,3\\}\\),[[:space:]]*\\([[:digit:]]\\{1,3\\}\\(?:\.?[[:digit:]]*\\)\\)%,[[:space:]]*\\([[:digit:]]\\{1,3\\}\\)\\(?:\.?[[:digit:]]*\\)%)")
97 (defconst css-color-rgb-re
98 "rgba?(\\([[:digit:]]\\{1,3\\}\\(?:\.?[[:digit:]]*%\\)?\\),[[:space:]]*\\([[:digit:]]\\{1,3\\}\\(?:\.?[[:digit:]]*%\\)?\\),[[:space:]]*\\([[:digit:]]\\{1,3\\}\\(?:\.?[[:digit:]]*%\\)?\\)\\(:?,[[:space:]]*\\(0\.[0-9]+\\|1\\)\\)?)")
100 (defconst css-color-html-colors
101 '(("AliceBlue" "#F0F8FF")
102 ("AntiqueWhite" "#FAEBD7")
104 ("Aquamarine" "#7FFFD4")
109 ("BlanchedAlmond" "#FFEBCD")
111 ("BlueViolet" "#8A2BE2")
113 ("BurlyWood" "#DEB887")
114 ("CadetBlue" "#5F9EA0")
115 ("Chartreuse" "#7FFF00")
116 ("Chocolate" "#D2691E")
118 ("CornflowerBlue" "#6495ED")
119 ("Cornsilk" "#FFF8DC")
120 ("Crimson" "#DC143C")
122 ("DarkBlue" "#00008B")
123 ("DarkCyan" "#008B8B")
124 ("DarkGoldenRod" "#B8860B")
125 ("DarkGray" "#A9A9A9")
126 ("DarkGrey" "#A9A9A9")
127 ("DarkGreen" "#006400")
128 ("DarkKhaki" "#BDB76B")
129 ("DarkMagenta" "#8B008B")
130 ("DarkOliveGreen" "#556B2F")
131 ("Darkorange" "#FF8C00")
132 ("DarkOrchid" "#9932CC")
133 ("DarkRed" "#8B0000")
134 ("DarkSalmon" "#E9967A")
135 ("DarkSeaGreen" "#8FBC8F")
136 ("DarkSlateBlue" "#483D8B")
137 ("DarkSlateGray" "#2F4F4F")
138 ("DarkSlateGrey" "#2F4F4F")
139 ("DarkTurquoise" "#00CED1")
140 ("DarkViolet" "#9400D3")
141 ("DeepPink" "#FF1493")
142 ("DeepSkyBlue" "#00BFFF")
143 ("DimGray" "#696969")
144 ("DimGrey" "#696969")
145 ("DodgerBlue" "#1E90FF")
146 ("FireBrick" "#B22222")
147 ("FloralWhite" "#FFFAF0")
148 ("ForestGreen" "#228B22")
149 ("Fuchsia" "#FF00FF")
150 ("Gainsboro" "#DCDCDC")
151 ("GhostWhite" "#F8F8FF")
153 ("GoldenRod" "#DAA520")
157 ("GreenYellow" "#ADFF2F")
158 ("HoneyDew" "#F0FFF0")
159 ("HotPink" "#FF69B4")
160 ("IndianRed" "#CD5C5C")
164 ("Lavender" "#E6E6FA")
165 ("LavenderBlush" "#FFF0F5")
166 ("LawnGreen" "#7CFC00")
167 ("LemonChiffon" "#FFFACD")
168 ("LightBlue" "#ADD8E6")
169 ("LightCoral" "#F08080")
170 ("LightCyan" "#E0FFFF")
171 ("LightGoldenRodYellow" "#FAFAD2")
172 ("LightGray" "#D3D3D3")
173 ("LightGrey" "#D3D3D3")
174 ("LightGreen" "#90EE90")
175 ("LightPink" "#FFB6C1")
176 ("LightSalmon" "#FFA07A")
177 ("LightSeaGreen" "#20B2AA")
178 ("LightSkyBlue" "#87CEFA")
179 ("LightSlateGray" "#778899")
180 ("LightSlateGrey" "#778899")
181 ("LightSteelBlue" "#B0C4DE")
182 ("LightYellow" "#FFFFE0")
184 ("LimeGreen" "#32CD32")
186 ("Magenta" "#FF00FF")
188 ("MediumAquaMarine" "#66CDAA")
189 ("MediumBlue" "#0000CD")
190 ("MediumOrchid" "#BA55D3")
191 ("MediumPurple" "#9370D8")
192 ("MediumSeaGreen" "#3CB371")
193 ("MediumSlateBlue" "#7B68EE")
194 ("MediumSpringGreen" "#00FA9A")
195 ("MediumTurquoise" "#48D1CC")
196 ("MediumVioletRed" "#C71585")
197 ("MidnightBlue" "#191970")
198 ("MintCream" "#F5FFFA")
199 ("MistyRose" "#FFE4E1")
200 ("Moccasin" "#FFE4B5")
201 ("NavajoWhite" "#FFDEAD")
203 ("OldLace" "#FDF5E6")
205 ("OliveDrab" "#6B8E23")
207 ("OrangeRed" "#FF4500")
209 ("PaleGoldenRod" "#EEE8AA")
210 ("PaleGreen" "#98FB98")
211 ("PaleTurquoise" "#AFEEEE")
212 ("PaleVioletRed" "#D87093")
213 ("PapayaWhip" "#FFEFD5")
214 ("PeachPuff" "#FFDAB9")
218 ("PowderBlue" "#B0E0E6")
221 ("RosyBrown" "#BC8F8F")
222 ("RoyalBlue" "#4169E1")
223 ("SaddleBrown" "#8B4513")
225 ("SandyBrown" "#F4A460")
226 ("SeaGreen" "#2E8B57")
227 ("SeaShell" "#FFF5EE")
230 ("SkyBlue" "#87CEEB")
231 ("SlateBlue" "#6A5ACD")
232 ("SlateGray" "#708090")
233 ("SlateGrey" "#708090")
235 ("SpringGreen" "#00FF7F")
236 ("SteelBlue" "#4682B4")
239 ("Thistle" "#D8BFD8")
241 ("Turquoise" "#40E0D0")
245 ("WhiteSmoke" "#F5F5F5")
247 ("YellowGreen" "#9ACD32")))
249 (defvar css-color-html-re
252 (mapcar 'car css-color-html-colors))
257 "\\(?:#\\(?:[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\\)\\)?)\\)"
258 "Regular expression containing only shy groups matching any type of CSS color")
260 ;; (defconst css-color-color-re
264 ;; (list css-color-hex-re
266 ;; css-color-rgb-re) "\\|")
269 (defvar css-color-keywords
273 (when (= 7 (- (match-end 0)
274 (match-beginning 0)))
275 (put-text-property (match-beginning 0)
277 'keymap css-color-map))
278 (put-text-property (match-beginning 0)
280 'css-color-type 'hex)
281 (put-text-property (match-beginning 0)
284 (put-text-property (match-beginning 0)
286 'face (list :background
287 (match-string-no-properties 0)
289 (css-color-foreground-color
290 (match-string-no-properties 0)))))))
294 (css-color-string-name-to-hex (match-string-no-properties 0))))
295 (put-text-property (match-beginning 0)
297 'keymap css-color-generic-map)
298 (put-text-property (match-beginning 0)
300 'css-color-type 'name)
301 (put-text-property (match-beginning 0)
304 (put-text-property (match-beginning 0)
306 'face (list :background
309 (css-color-foreground-color
313 (let ((color (concat "#" (apply 'css-color-hsl-to-hex
314 (mapcar 'string-to-number
316 (match-string-no-properties 1)
317 (match-string-no-properties 2)
318 (match-string-no-properties 3)))))))
319 (put-text-property (match-beginning 0)
321 'keymap css-color-generic-map)
322 (put-text-property (match-beginning 0)
324 'css-color-type 'hsl)
325 (put-text-property (match-beginning 0)
328 (put-text-property (match-beginning 0)
330 'face (list :background
333 (css-color-foreground-color
337 (let ((color (css-color-string-rgb-to-hex (match-string-no-properties 0))))
338 (put-text-property (match-beginning 0)
340 'keymap css-color-generic-map)
341 (put-text-property (match-beginning 0)
343 'css-color-type 'rgb)
344 (put-text-property (match-beginning 0)
347 (put-text-property (match-beginning 0)
349 'face (list :background
352 (css-color-foreground-color
357 (define-minor-mode css-color-mode
358 "Show hex color literals with the given color as background.
359 In this mode hexadecimal colour specifications like #6600ff are
360 displayed with the specified colour as background.
362 Certain keys are bound to special colour editing commands when
363 point is at a hexadecimal colour:
368 (unless font-lock-defaults
369 (error "Can't use css-color-mode for this major mode"))
372 (unless font-lock-mode (font-lock-mode 1))
373 (css-color-font-lock-hook-fun)
374 (add-hook 'font-lock-mode-hook 'css-color-font-lock-hook-fun nil t))
375 (remove-hook 'font-lock-mode-hook 'css-color-font-lock-hook-fun t)
376 (font-lock-remove-keywords nil css-color-keywords))
377 ;;(font-lock-fontify-buffer)
380 (mumamo-mark-for-refontification (point-min) (point-max))))
382 (put 'css-color-mode 'permanent-local t)
384 (defun css-color-turn-on-in-buffer ()
385 "Turn on `css-color-mode' in `css-mode'."
386 (when (derived-mode-p 'css-mode)
390 (define-globalized-minor-mode css-color-global-mode css-color-mode
391 css-color-turn-on-in-buffer
394 (defun css-color-font-lock-hook-fun ()
395 "Add css-color pattern to font-lock's."
397 (font-lock-add-keywords nil css-color-keywords t)
398 (css-color-mode -1)))
400 (defvar css-color-map
401 (let ((m (make-sparse-keymap "css-color")))
402 (define-key m "=" 'css-color-up)
403 (define-key m "-" 'css-color-down)
404 (define-key m "h" 'css-color-hue-up)
405 (define-key m "H" 'css-color-hue-down)
406 (define-key m "s" 'css-color-saturation-up)
407 (define-key m "S" 'css-color-saturation-down)
408 (define-key m "v" 'css-color-value-up)
409 (define-key m "V" 'css-color-value-down)
410 (define-key m "\t" 'css-color-next-channel)
411 (define-key m " " 'css-color-cycle-type)
413 "Mode map for `css-color-minor-mode'")
415 (defvar css-color-generic-map
416 (let ((m (make-sparse-keymap "css-color")))
417 (define-key m "=" 'css-color-num-up)
418 (define-key m "-" 'css-color-num-down)
419 (define-key m " " 'css-color-cycle-type)
420 (define-key m "%" 'css-color-toggle-percentage)
421 (define-key m "\t" 'css-color-next-channel)
423 "Mode map for simple numbers in `css-color-minor-mode'")
425 (defun css-color-pal-lumsig (r g b)
426 "Return PAL luminance signal, but in range 0-255."
432 (defun css-color-foreground-color (hex-color)
433 (multiple-value-bind (r g b) (css-color-hex-to-rgb hex-color)
434 (if (< (css-color-pal-lumsig r g b) 128)
439 (defun css-color-normalize-hue (h)
440 (mod (+ (mod h 360) 360) 360))
442 (defun css-color-within-bounds (num min max)
443 (min (max min num) max))
446 (defun css-color-hex-to-rgb (str)
448 ((not (string-match "^#?[a-fA-F[:digit:]]*$" str))
449 (error "No valid hexadecimal: %s" str))
453 (css-color-hex-to-rgb (substring str 1)))
454 (;;(oddp (length str))
455 (= (mod (length str) 2) 1)
456 (css-color-hex-to-rgb (mapconcat (lambda (c)
458 (string-to-list str) "")))
459 (t (cons (string-to-number (substring str 0 2) 16)
460 (css-color-hex-to-rgb (substring str 2))))))
462 (defun css-color-hex-to-hsv (hex)
463 (multiple-value-bind (r g b) (css-color-hex-to-rgb hex)
464 (css-color-rgb-to-hsv r g b)))
467 (defun css-color-rgb-to-hex (r g b)
468 "Return r g b as #rrggbb in hexadecimal, propertized to have
469 the keymap `css-color-map'"
470 (format "%02x%02x%02x" r g b)) ;val
472 (defun css-color-rgb-to-hsv (r g b)
473 "Return list of (hue saturation value).
474 Arguments are: R = red; G = green; B = blue.
475 Measure saturation and value on a scale from 0 - 100.
476 GIMP-style, that is."
484 (cond ((and (= r g) (= g b)) 0)
487 (* 60 (/ (- g b) (- max min))))
490 (+ 360 (* 60 (/ (- g b) (- max min)))))
492 (+ 120 (* 60 (/ (- b r) (- max min)))))
494 (+ 240 (* 60 (/ (- r g) (- max min))))))) ;hue
495 (round (* 100 (if (= max 0) 0 (- 1 (/ min max))))) ;sat
496 (round (/ max 2.55)))))
498 (defun css-color-rgb-to-hsl (r g b)
499 "Return R G B (in range 0-255) converted to HSL (0-360 for hue, rest in %)"
500 (let* ((r (/ r 255.0))
513 (multiple-value-bind (h s v)
520 (setq s (/ s (if (<= l 0.5)
524 (setq r2 (/ (- v r) vm)
539 (values (/ h 6.0) s l)))
540 (list (round(* 360 h))
545 (defun css-color-hsv-to-hsl (h s v)
546 (multiple-value-bind (r g b) (css-color-hsv-to-rgb h s v)
547 (css-color-rgb-to-hsl r g b)))
549 (defun css-color-hsv-to-hex (h s v)
550 (apply 'css-color-rgb-to-hex (css-color-hsv-to-rgb h s v)))
552 (defun css-color-hsv-to-rgb (h s v)
553 "Convert a point in the Hue, Saturation, Value (aka Brightness)
554 color space to list of normalized Red, Green, Blue values.
556 HUE is an angle in the range of 0 degrees inclusive to 360
557 exclusive. The remainder of division by 360 is used for
559 SATURATION is in the range of 0 to 100.
560 VALUE is in the range of 0 to 100.
561 Returns a list of values in the range of 0 to 255.
563 ;; Coerce to float and get hue into range.
564 (setq h (mod h 360.0)
567 (let* ((hi (floor h 60.0))
568 (f (- (/ h 60.0) hi))
570 (q (* v (- 1.0 (* f s))))
571 ;; cannot use variable t, obviously.
572 (u (* v (- 1.0 (* (- 1.0 f) s))))
575 (0 (setq r v g u b p))
576 (1 (setq r q g v b p))
577 (2 (setq r p g v b u))
578 (3 (setq r p g q b v))
579 (4 (setq r u g p b v))
580 (5 (setq r v g p b q)))
581 (mapcar (lambda (color) (round (* 255 color))) (list r g b))))
583 (defun css-color-hsv-to-prop-hexstring (color-data)
585 (apply 'css-color-hsv-to-hex color-data)
586 'keymap css-color-map
587 'css-color color-data))
590 (defun css-color-hsl-to-rgb-fractions (h s l)
593 (setq m2 (* l (+ s 1)))
594 (setq m2 (- (+ l s) (* l s))))
595 (setq m1 (- (* l 2) m2))
596 (values (css-color-hue-to-rgb m1 m2 (+ h (/ 1 3.0)))
597 (css-color-hue-to-rgb m1 m2 h)
598 (css-color-hue-to-rgb m1 m2 (- h (/ 1 3.0))))))
600 (defun css-color-hsl-to-rgb (h s l)
601 (multiple-value-bind (r g b)
602 (css-color-hsl-to-rgb-fractions
603 (/ h;; (css-color-normalize-hue h)
607 (values (css-color-within-bounds (* 256 r) 0 255)
608 (css-color-within-bounds (* 256 g) 0 255)
609 (css-color-within-bounds (* 256 b) 0 255))))
611 (defun css-color-hsl-to-hex (h s l)
612 (apply 'css-color-rgb-to-hex
613 (css-color-hsl-to-rgb h s l)))
615 (defun css-color-hue-to-rgb (x y h)
616 (when (< h 0) (incf h))
617 (when (> h 1) (decf h))
618 (cond ((< h (/ 1 6.0))
619 (+ x (* (- y x) h 6)))
622 (+ x (* (- y x) (- (/ 2.0 3.0) h) 6)))
625 (defun css-color-parse-hsl (str)
629 (mapcar 'string-to-number
633 (match-string 3 str))))
635 (defun css-color-inchue (color incr)
636 (multiple-value-bind (h s v) color
637 (css-color-hsv-to-prop-hexstring
638 (list (+ incr h) s v))))
640 (defun css-color-incsat (color incr)
641 (multiple-value-bind (h s v) color
642 (css-color-hsv-to-prop-hexstring
643 (list h (css-color-within-bounds (+ incr s) 0 100) v))))
645 (defun css-color-incval (color incr)
646 (multiple-value-bind (h s v) color
647 (css-color-hsv-to-prop-hexstring
648 (list h s (css-color-within-bounds (+ incr v) 0 100)))))
650 (defun css-color-hexval-beginning ()
651 (skip-chars-backward css-color-hex-chars)
652 (if (= (char-after) 35)
655 (defun css-color-replcolor-at-p (fun increment)
657 (css-color-hexval-beginning)
660 (css-color-get-color-at-point)
662 (delete-region (point) (+ (point) 6))
665 (defun css-color-get-color-at-point ()
667 (css-color-hexval-beginning)
668 (let ((saved-color (get-text-property (point) 'css-color)))
670 (css-color-hex-to-hsv
671 (buffer-substring-no-properties (point) (+ (point) 6)))))))
673 (defun css-color-adj-hue-at-p (increment)
675 (css-color-replcolor-at-p 'css-color-inchue increment))
677 (defun css-color-adj-saturation-at-p (increment)
679 (css-color-replcolor-at-p 'css-color-incsat increment))
681 (defun css-color-adj-value-at-p (increment)
683 (css-color-replcolor-at-p 'css-color-incval increment))
685 (defun css-color-what-channel ()
688 (/ (skip-chars-backward css-color-hex-chars) -2)
691 (defun css-color-adjust-hex-at-p (incr)
694 (channel (css-color-what-channel)))
695 (css-color-hexval-beginning)
697 (css-color-hex-to-rgb
698 (buffer-substring-no-properties (point)
700 (setf (nth channel rgb)
701 (css-color-within-bounds
702 (+ incr (nth channel rgb))
704 (delete-region (point) (+ 6 (point)))
707 (apply 'format "%02x%02x%02x" rgb)
708 'keymap css-color-map
713 ;; channels (r, g, b)
714 (defun css-color-up (val)
717 (css-color-adjust-hex-at-p val))
719 (defun css-color-down (val)
722 (css-color-adjust-hex-at-p (- val)))
724 (defun css-color-hue-up (val)
727 (css-color-adj-hue-at-p val))
729 (defun css-color-hue-down (val)
732 (css-color-adj-hue-at-p (- val)))
734 (defun css-color-saturation-up (val)
735 "Adjust Saturation up."
737 (css-color-adj-saturation-at-p val))
739 (defun css-color-saturation-down (val)
740 "Adjust Saturation down."
742 (css-color-adj-saturation-at-p (- val)))
744 (defun css-color-value-up (val)
747 (css-color-adj-value-at-p val))
749 (defun css-color-value-down (val)
752 (css-color-adj-value-at-p (- val)))
754 (defun css-color-num-up (arg)
755 "Adjust HEX number up."
758 (let ((digits "1234567890"))
759 (skip-chars-backward digits)
761 (looking-at "[[:digit:]]+")
764 (let ((num (+ (string-to-number (match-string 0)) arg)))
765 ;max = 100 when at percentage
767 (cond ((looking-at "[[:digit:]]+%")
768 (setq num (min num 100)))
769 ((looking-back "hsla?(")
770 (setq num (css-color-normalize-hue num)))
771 ((memq 'css-color-type (text-properties-at (point)))
772 (setq num (min num 255)))))
773 (number-to-string num))
775 css-color-generic-map))))))
777 (defun css-color-num-down (arg)
778 "Adjust HEX number down."
781 (let ((digits "1234567890"))
782 (skip-chars-backward digits)
784 (looking-at "[[:digit:]]+")
787 (let ((num (- (string-to-number (match-string 0)) arg)))
788 ;max = 100 when at percentage
790 (cond ((looking-back "hsla?(")
791 (setq num (css-color-normalize-hue num)))
792 (t (setq num (max 0 num)))))
793 (number-to-string num))
794 'keymap css-color-generic-map))))))
797 (defun css-color-beginning-of-color ()
798 "Skip to beginning of color.
800 Return list of point and color-type."
801 (while (memq 'css-color-type (text-properties-at (point)))
804 (cons (point) (plist-get (text-properties-at (point)) 'css-color-type)))
806 (defun css-color-end-of-color ()
807 "Skip to beginning of color.
809 Return list of point and color-type."
810 (while (plist-get (text-properties-at (point)) 'css-color-type)
812 (cons (point) (plist-get (text-properties-at (1- (point))) 'css-color-type)))
814 (defun css-color-color-info ()
815 (destructuring-bind ((beg . type)
818 (css-color-beginning-of-color)
819 (css-color-end-of-color))
820 (list beg end type (buffer-substring-no-properties beg end))))
822 (defconst css-color-type-circle '#1=(hex hsl rgb name . #1#))
824 (defun css-color-next-type (sym)
825 (cadr (member sym css-color-type-circle)))
827 (defun css-color-cycle-type ()
830 (destructuring-bind (beg end type color) (css-color-color-info)
831 (if (or (= 0 (length color)) (null type))
832 (error "Not at color"))
833 (delete-region beg end)
836 (intern-soft (format "css-color-string-%s-to-%s"
838 (css-color-next-type type)))
840 'keymap (if (eq (css-color-next-type type) 'hex)
842 css-color-generic-map) 'rear-nonsticky t))
845 (defun css-color-string-hex-to-hsl (str)
846 (multiple-value-bind (h s l)
847 (apply 'css-color-rgb-to-hsl
848 (css-color-hex-to-rgb str))
849 (format "hsl(%d,%d%%,%d%%)"
852 (defun css-color-string-hsl-to-rgb (str)
853 (multiple-value-bind (h s l)
854 (css-color-parse-hsl str)
857 (mapcar 'round (css-color-hsl-to-rgb h s l)))))
859 (defun css-color-string-rgb-to-name (str)
860 (let ((color (css-color-string-rgb-to-hex str)))
861 (or (car (rassoc (list (upcase color)) css-color-html-colors)) ;if name ok
862 color))) ;else return hex
864 (defun css-color-string-name-to-hex (str)
865 (let ((str (downcase str)))
871 css-color-html-colors))))
873 (defun css-color-string-rgb-to-hex (str)
875 (string-match css-color-rgb-re str)
877 (apply 'css-color-rgb-to-hex
881 (if (= (aref s (1- (length s))) ?\%)
882 (round (* (string-to-number s) 2.55))
883 (string-to-number s)))
885 (match-string-no-properties 1 str)
886 (match-string-no-properties 2 str)
887 (match-string-no-properties 3 str)))))))
889 (defun css-color-string-hsl-to-hex (str)
890 (concat "#" (apply 'css-color-hsl-to-hex (css-color-parse-hsl str))))
892 (defun css-color-next-channel ()
893 "Cycle color channel."
895 (multiple-value-bind (beg end type color)
896 (save-excursion (css-color-color-info))
899 (if (not (re-search-forward ",\\|(" end t))
900 (goto-char (+ beg 4))))
902 (cond ((> (point) (- end 3))
903 (goto-char (+ 1 beg)))
906 ((evenp (- (point) beg))
908 (t (forward-char 2)))))))
910 (defun css-color-hexify-anystring (str)
911 (cond ((string-match "^hsl" str)
912 (css-color-string-hsl-to-hex str))
913 ((string-match "^rgb" str)
914 (css-color-string-rgb-to-hex str))
917 (defun css-color-toggle-percentage ()
921 (if (eq (nth 2 (save-excursion (css-color-color-info))) 'rgb)
922 (let ((chars "%1234567890."))
923 (skip-chars-backward chars)
925 (looking-at "[[:digit:]]+\\(?:\.?[[:digit:]]*%\\)?%?")
926 (let ((s (match-string 0)))
929 (if (= (aref s (1- (length s))) ?\%)
930 (number-to-string (round (* (string-to-number s) 2.55)))
931 (format "%d%%" (/ (string-to-number s) 2.55)))
932 'keymap css-color-generic-map
936 (message "No toggling at point."))))
938 ;; provide some backwards-compatibility to hexcolor.el:
939 (defvar css-color-fg-history nil)
940 (defvar css-color-bg-history nil)
943 (defun css-color-test (fg-color bg-color)
944 "Test colors interactively.
945 The colors are displayed in the echo area. You can specify the
946 colors as any viable css color. Example:
954 (interactive (list (completing-read "Foreground color: "
955 css-color-html-colors
956 nil nil nil nil css-color-fg-history)
957 (completing-read "Background color: "
958 css-color-html-colors
959 nil nil nil nil css-color-bg-history)))
960 (let* ((s (concat " Foreground: " fg-color ", Background: " bg-color " ")))
961 (put-text-property 0 (length s)
963 :foreground (css-color-hexify-anystring fg-color)
964 :background (css-color-hexify-anystring bg-color))
966 (message "Here are the colors: %s" s)))
968 (defun css-color-run-tests ()
973 (string= (css-color-string-hex-to-hsl "#ffff00") "hsl(60,100%,50%)"))
975 (string= (css-color-string-rgb-to-hex "rgb(255, 50%, 0)")"#ff7f00"))
977 (string= (css-color-string-hsl-to-rgb "hsl(60, 100%, 50%)") "rgb(255,255,0)"))
979 (string= (css-color-string-hsl-to-hex "hsl(60, 100%, 50%)") "#ffff00")))
980 (message "All tests passed")))
983 ;;; css-color.el ends here