martin/emacs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add command for cycling between CSS color formats

Browse Source 
* lisp/textmodes/css-mode.el (css-mode-map): Add keybinding for
'css-cycle-color-format'.
(css--rgb-color): Add support for extracting alpha component.
(css--hex-alpha, css--color-to-4-dpc, css--named-color-to-hex)
(css--format-rgba-alpha, css--hex-to-rgb)
(css--rgb-to-named-color-or-hex): New functions.
(css-cycle-color-format): New command for cycling between color
formats.

* test/lisp/textmodes/css-mode-tests.el (css-test-color-to-4-dpc):
(css-test-named-color-to-hex, css-test-format-rgba-alpha)
(css-test-hex-to-rgb, css-test-rgb-to-named-color-or-hex)
(css-test-cycle-color-format, css-test-hex-alpha): New tests for the
changes mentioned above.

* etc/NEWS: Mention the new command.
This commit is contained in:
Simen Heggestøyl
2017-12-16 09:49:54 +01:00
parent ac0d6c06b8
commit bd9e8b31a1
3 changed files with 207 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
etc/NEWS
View File

@@ -77,6 +77,13 @@ whether '"' is also replaced in 'electric-quote-mode'. If non-nil,
* Changes in Specialized Modes and Packages in Emacs 27.1
** CSS mode
---
*** A new command 'css-cycle-color-format' for cycling between color
formats (e.g. "black" => "#000000" => "rgb(0, 0, 0)") has been added,
bound to 'C-c C-f'.
** Dired
+++

133
lisp/textmodes/css-mode.el
View File

@@ -32,12 +32,13 @@
;;; Code:
(require 'eww)
(require 'cl-lib)
(require 'color)
(require 'eww)
(require 'seq)
(require 'sgml-mode)
(require 'smie)
(require 'thingatpt)
(eval-when-compile (require 'subr-x))
(defgroup css nil
@@ -806,6 +807,7 @@ cannot be completed sensibly: `custom-ident',
(defvar css-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [remap info-lookup-symbol] 'css-lookup-symbol)
(define-key map "\C-c\C-f" 'css-cycle-color-format)
map)
"Keymap used in `css-mode'.")
@@ -936,11 +938,13 @@ cannot be completed sensibly: `custom-ident',
"Skip blanks and comments."
(while (forward-comment 1)))
(cl-defun css--rgb-color ()
(cl-defun css--rgb-color (&optional include-alpha)
"Parse a CSS rgb() or rgba() color.
Point should be just after the open paren.
Returns a hex RGB color, or nil if the color could not be recognized.
This recognizes CSS-color-4 extensions."
This recognizes CSS-color-4 extensions.
When INCLUDE-ALPHA is non-nil, the alpha component is included in
the returned hex string."
(let ((result '())
(iter 0))
(while (< iter 4)
@@ -952,8 +956,8 @@ This recognizes CSS-color-4 extensions."
(number (string-to-number str)))
(when is-percent
(setq number (* 255 (/ number 100.0))))
;; Don't push the alpha.
(when (< iter 3)
(if (and include-alpha (= iter 3))
(push (round (* number 255)) result)
(push (min (max 0 (truncate number)) 255) result))
(goto-char (match-end 0))
(css--color-skip-blanks)
@@ -966,7 +970,11 @@ This recognizes CSS-color-4 extensions."
(css--color-skip-blanks)))
(when (looking-at ")")
(forward-char)
(apply #'format "#%02x%02x%02x" (nreverse result)))))
(apply #'format
(if (and include-alpha (= (length result) 4))
"#%02x%02x%02x%02x"
"#%02x%02x%02x")
(nreverse result)))))
(cl-defun css--hsl-color ()
"Parse a CSS hsl() or hsla() color.
@@ -1039,6 +1047,14 @@ This function simply drops any transparency."
;; Either #RGB or #RRGGBB, drop the "A" or "AA".
(substring str 0 (if (> (length str) 5) 7 4)))
(defun css--hex-alpha (hex)
"Return the alpha component of CSS color HEX.
HEX can either be in the #RGBA or #RRGGBBAA format. Return nil
if the color doesn't have an alpha component."
(cl-case (length hex)
(5 (string (elt hex 4)))
(9 (substring hex 7 9))))
(defun css--named-color (start-point str)
"Check whether STR, seen at point, is CSS named color.
Returns STR if it is a valid color. Special care is taken
@@ -1381,6 +1397,111 @@ tags, classes and IDs."
(progn (insert ": ;")
(forward-char -1))))))))))
(defun css--color-to-4-dpc (hex)
"Convert the CSS color HEX to four digits per component.
CSS colors use one or two digits per component for RGB hex
values. Convert the given color to four digits per component.
Note that this function handles CSS colors specifically, and
should not be mixed with those in color.el."
(let ((six-digits (= (length hex) 7)))
(apply
#'concat
`("#"
,@(seq-mapcat
(apply-partially #'make-list (if six-digits 2 4))
(seq-partition (seq-drop hex 1) (if six-digits 2 1)))))))
(defun css--named-color-to-hex ()
"Convert named CSS color at point to hex format.
Return non-nil if a conversion was made.
Note that this function handles CSS colors specifically, and
should not be mixed with those in color.el."
(save-excursion
(unless (or (looking-at css--colors-regexp)
(eq (char-before) ?#))
(backward-word))
(when (member (word-at-point) (mapcar #'car css--color-map))
(looking-at css--colors-regexp)
(let ((color (css--compute-color (point) (match-string 0))))
(replace-match color))
t)))
(defun css--format-rgba-alpha (alpha)
"Return ALPHA component formatted for use in rgba()."
(let ((a (string-to-number (format "%.2f" alpha))))
(if (or (= a 0)
(= a 1))
(format "%d" a)
(string-remove-suffix "0" (number-to-string a)))))
(defun css--hex-to-rgb ()
"Convert CSS hex color at point to RGB format.
Return non-nil if a conversion was made.
Note that this function handles CSS colors specifically, and
should not be mixed with those in color.el."
(save-excursion
(unless (or (eq (char-after) ?#)
(eq (char-before) ?\())
(backward-sexp))
(when-let* ((hex (when (looking-at css--colors-regexp)
(and (eq (elt (match-string 0) 0) ?#)
(match-string 0))))
(rgb (css--hex-color hex)))
(seq-let (r g b)
(mapcar (lambda (x) (round (* x 255)))
(color-name-to-rgb (css--color-to-4-dpc rgb)))
(replace-match
(if-let* ((alpha (css--hex-alpha hex))
(a (css--format-rgba-alpha
(/ (string-to-number alpha 16)
(float (expt 16 (length alpha)))))))
(format "rgba(%d, %d, %d, %s)" r g b a)
(format "rgb(%d, %d, %d)" r g b))
t))
t)))
(defun css--rgb-to-named-color-or-hex ()
"Convert CSS RGB color at point to a named color or hex format.
Convert to a named color if the color at point has a name, else
convert to hex format. Return non-nil if a conversion was made.
Note that this function handles CSS colors specifically, and
should not be mixed with those in color.el."
(save-excursion
(when-let* ((open-paren-pos (nth 1 (syntax-ppss))))
(when (save-excursion
(goto-char open-paren-pos)
(looking-back "rgba?" (- (point) 4)))
(goto-char (nth 1 (syntax-ppss)))))
(when (eq (char-before) ?\))
(backward-sexp))
(skip-chars-backward "rgba")
(when (looking-at css--colors-regexp)
(let* ((start (match-end 0))
(color (save-excursion
(goto-char start)
(css--rgb-color t))))
(when color
(kill-sexp)
(kill-sexp)
(let ((named-color (seq-find (lambda (x) (equal (cdr x) color))
css--color-map)))
(insert (if named-color (car named-color) color)))
t)))))
(defun css-cycle-color-format ()
"Cycle the color at point between different CSS color formats.
Supported formats are by name (if possible), hexadecimal, and
rgb()/rgba()."
(interactive)
(or (css--named-color-to-hex)
(css--hex-to-rgb)
(css--rgb-to-named-color-or-hex)
(message "It doesn't look like a color at point")))
;;;###autoload
(define-derived-mode css-mode prog-mode "CSS"
"Major mode to edit Cascading Style Sheets (CSS).

73
test/lisp/textmodes/css-mode-tests.el
View File

@@ -244,6 +244,73 @@
(should (member "body" completions))
(should-not (member "article" completions)))))
(ert-deftest css-test-color-to-4-dpc ()
(should (equal (css--color-to-4-dpc "#ffffff")
(css--color-to-4-dpc "#fff")))
(should (equal (css--color-to-4-dpc "#aabbcc")
(css--color-to-4-dpc "#abc")))
(should (equal (css--color-to-4-dpc "#fab")
"#ffffaaaabbbb"))
(should (equal (css--color-to-4-dpc "#fafbfc")
"#fafafbfbfcfc")))
(ert-deftest css-test-named-color-to-hex ()
(dolist (item '(("black" "#000000")
("white" "#ffffff")
("salmon" "#fa8072")))
(with-temp-buffer
(css-mode)
(insert (nth 0 item))
(css--named-color-to-hex)
(should (equal (buffer-string) (nth 1 item))))))
(ert-deftest css-test-format-rgba-alpha ()
(should (equal (css--format-rgba-alpha 0) "0"))
(should (equal (css--format-rgba-alpha 0.0) "0"))
(should (equal (css--format-rgba-alpha 0.00001) "0"))
(should (equal (css--format-rgba-alpha 1) "1"))
(should (equal (css--format-rgba-alpha 1.0) "1"))
(should (equal (css--format-rgba-alpha 1.00001) "1"))
(should (equal (css--format-rgba-alpha 0.10000) "0.1"))
(should (equal (css--format-rgba-alpha 0.100001) "0.1"))
(should (equal (css--format-rgba-alpha 0.2524334) "0.25")))
(ert-deftest css-test-hex-to-rgb ()
(dolist (item '(("#000" "rgb(0, 0, 0)")
("#000000" "rgb(0, 0, 0)")
("#fff" "rgb(255, 255, 255)")
("#ffffff" "rgb(255, 255, 255)")
("#ffffff80" "rgba(255, 255, 255, 0.5)")
("#fff8" "rgba(255, 255, 255, 0.5)")))
(with-temp-buffer
(css-mode)
(insert (nth 0 item))
(css--hex-to-rgb)
(should (equal (buffer-string) (nth 1 item))))))
(ert-deftest css-test-rgb-to-named-color-or-hex ()
(dolist (item '(("rgb(0, 0, 0)" "black")
("rgb(255, 255, 255)" "white")
("rgb(255, 255, 240)" "ivory")
("rgb(18, 52, 86)" "#123456")
("rgba(18, 52, 86, 0.5)" "#12345680")))
(with-temp-buffer
(css-mode)
(insert (nth 0 item))
(css--rgb-to-named-color-or-hex)
(should (equal (buffer-string) (nth 1 item))))))
(ert-deftest css-test-cycle-color-format ()
(with-temp-buffer
(css-mode)
(insert "black")
(css-cycle-color-format)
(should (equal (buffer-string) "#000000"))
(css-cycle-color-format)
(should (equal (buffer-string) "rgb(0, 0, 0)"))
(css-cycle-color-format)
(should (equal (buffer-string) "black"))))
(ert-deftest css-mdn-symbol-guessing ()
(dolist (item '(("@med" "ia" "@media")
("@keyframes " "{" "@keyframes")
@@ -301,6 +368,12 @@
(should (equal (css--hex-color "#aabbcc") "#aabbcc"))
(should (equal (css--hex-color "#aabbccdd") "#aabbcc")))
(ert-deftest css-test-hex-alpha ()
(should (equal (css--hex-alpha "#abcd") "d"))
(should-not (css--hex-alpha "#abc"))
(should (equal (css--hex-alpha "#aabbccdd") "dd"))
(should-not (css--hex-alpha "#aabbcc")))
(ert-deftest css-test-named-color ()
(dolist (text '("@mixin black" "@include black"))
(with-temp-buffer