Shorten CSS hex colors when possible

* lisp/textmodes/css-mode.el (css--format-hex): New function for
shortening CSS hex colors when possible.
(css--named-color-to-hex, css--rgb-to-named-color-or-hex): Use it.

* test/lisp/textmodes/css-mode-tests.el (css-test-format-hex): New
tests for 'css--format-hex'.
(css-test-named-color-to-hex, css-test-cycle-color-format): Adjust for
the changes to 'css--named-color-to-hex' and
'css--rgb-to-named-color-or-hex'.

diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 135c0d5f92825bd987b15c3aac5b10ab301da066..55c21f8acb071f737c13193b79df6fbbe4b938ca 100644 (file)
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1413,6 +1413,15 @@ should not be mixed with those in color.el."
           (apply-partially #'make-list (if six-digits 2 4))
           (seq-partition (seq-drop hex 1) (if six-digits 2 1)))))))
 
+(defun css--format-hex (hex)
+  "Format a CSS hex color by shortening it if possible."
+  (let ((parts (seq-partition (seq-drop hex 1) 2)))
+    (if (and (>= (length hex) 6)
+             (seq-every-p (lambda (p) (eq (elt p 0) (elt p 1))) parts))
+        (apply #'string
+               (cons ?# (mapcar (lambda (p) (elt p 0)) parts)))
+      hex)))
+
 (defun css--named-color-to-hex ()
   "Convert named CSS color at point to hex format.
 Return non-nil if a conversion was made.
@@ -1426,7 +1435,7 @@ should not be mixed with those in color.el."
     (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))
+        (replace-match (css--format-hex color)))
       t)))
 
 (defun css--format-rgba-alpha (alpha)
@@ -1490,7 +1499,9 @@ should not be mixed with those in color.el."
           (kill-sexp)
           (let ((named-color (seq-find (lambda (x) (equal (cdr x) color))
                                        css--color-map)))
-            (insert (if named-color (car named-color) color)))
+            (insert (if named-color
+                        (car named-color)
+                      (css--format-hex color))))
           t)))))
 
 (defun css-cycle-color-format ()

diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el
index 4883123843d99f3d95ca22a1ce2a9798f7d5c170..a8ce9944169bfa593389dc5b92ae0aa2fe06bb36 100644 (file)
--- a/test/lisp/textmodes/css-mode-tests.el
+++ b/test/lisp/textmodes/css-mode-tests.el
@@ -254,9 +254,18 @@
   (should (equal (css--color-to-4-dpc "#fafbfc")
                  "#fafafbfbfcfc")))
 
+(ert-deftest css-test-format-hex ()
+  (should (equal (css--format-hex "#fff") "#fff"))
+  (should (equal (css--format-hex "#ffffff") "#fff"))
+  (should (equal (css--format-hex "#aabbcc") "#abc"))
+  (should (equal (css--format-hex "#12ff34") "#12ff34"))
+  (should (equal (css--format-hex "#aabbccdd") "#abcd"))
+  (should (equal (css--format-hex "#aabbccde") "#aabbccde"))
+  (should (equal (css--format-hex "#abcdef") "#abcdef")))
+
 (ert-deftest css-test-named-color-to-hex ()
-  (dolist (item '(("black" "#000000")
-                  ("white" "#ffffff")
+  (dolist (item '(("black" "#000")
+                  ("white" "#fff")
                   ("salmon" "#fa8072")))
     (with-temp-buffer
       (css-mode)
@@ -309,7 +318,7 @@
     (css-mode)
     (insert "black")
     (css-cycle-color-format)
-    (should (equal (buffer-string) "#000000"))
+    (should (equal (buffer-string) "#000"))
     (css-cycle-color-format)
     (should (equal (buffer-string) "rgb(0, 0, 0)"))
     (css-cycle-color-format)