diff options
Diffstat (limited to 'emacs.d/nxhtml/util/css-color.el')
| -rw-r--r-- | emacs.d/nxhtml/util/css-color.el | 983 |
1 files changed, 983 insertions, 0 deletions
diff --git a/emacs.d/nxhtml/util/css-color.el b/emacs.d/nxhtml/util/css-color.el new file mode 100644 index 0000000..38d400c --- /dev/null +++ b/emacs.d/nxhtml/util/css-color.el @@ -0,0 +1,983 @@ +;;; 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 |