From: "Simen Heggestøyl" <simenheg@gmail.com>
To: "Simen Heggestøyl" <simenheg@gmail.com>
Cc: 29456@debbugs.gnu.org, tom@tromey.com, monnier@iro.umontreal.ca
Subject: bug#29456: [PATCH] Add command for cycling between CSS color formats
Date: Sun, 10 Dec 2017 13:46:14 +0100 [thread overview]
Message-ID: <1512909974.15208.0@smtp.gmail.com> (raw)
In-Reply-To: <87shcyce9x.fsf@gmail.com>
[-- Attachment #1.1: Type: text/plain, Size: 431 bytes --]
I've updated the patch to support switching between #RGBA/#RRGGBBAA and
rgba() too, fixing a bug in `css--hex-color' along the way for handling
the #RGBA case. If you agree, I think that fix should go into the
emacs-26 branch as well.
I also prefixed the function names with `css--' to more strongly
indicate that they're intended for internal usage, and mentioned in the
docstrings their incompatibility with color.el.
-- Simen
[-- Attachment #1.2: Type: text/html, Size: 577 bytes --]
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-command-for-cycling-between-CSS-color-formats.patch --]
[-- Type: text/x-patch, Size: 12890 bytes --]
From 70d8834de32e31862dc0f14ce80f7e608e4151db Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Simen=20Heggest=C3=B8yl?= <simenheg@gmail.com>
Date: Sun, 17 Sep 2017 20:08:18 +0200
Subject: [PATCH] Add command for cycling between CSS color formats
* 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-color): Correct function when the hex string is in
the #RGBA format.
(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-color)
(css-test-hex-alpha): New tests for the changes mentioned above.
* etc/NEWS: Mention the new command.
---
etc/NEWS | 7 ++
lisp/textmodes/css-mode.el | 133 ++++++++++++++++++++++++++++++++--
test/lisp/textmodes/css-mode-tests.el | 77 ++++++++++++++++++++
3 files changed, 210 insertions(+), 7 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index dd7d983970..33eaf257df 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -63,6 +63,13 @@ whether '"' is also replaced in 'electric-quote-mode'. If non-nil,
\f
* 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
+++
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 93ca36b08a..6bf365ecb3 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -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 @@ css-mode-syntax-table
(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 @@ css--color-skip-blanks
"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 @@ css--color-skip-blanks
(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 @@ css--color-skip-blanks
(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.
@@ -1037,10 +1045,18 @@ css--hex-color
STR is the incoming CSS hex color.
This function simply drops any transparency."
;; Either #RGB or #RRGGBB, drop the "A" or "AA".
- (if (> (length str) 4)
+ (if (> (length str) 5)
(substring str 0 7)
(substring str 0 4)))
+(defun css--hex-alpha (hex)
+ "Return the alpha component of CSS color HEX.
+HEX can either be in the #RGBA or #RRGGBBAA format. If the color
+doesn't have an alpha component, nil is returned."
+ (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
@@ -1383,6 +1399,109 @@ css-completion-at-point
(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()."
+ (if (or (= alpha 0)
+ (= alpha 1))
+ (format "%d" alpha)
+ (string-remove-suffix "0" (format "%.2f" alpha))))
+
+(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)))
+
+(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."
+ (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).
diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el
index 47cf5f9244..f3d4243721 100644
--- a/test/lisp/textmodes/css-mode-tests.el
+++ b/test/lisp/textmodes/css-mode-tests.el
@@ -244,6 +244,71 @@ css-mode-tests--completions
(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 1) "1"))
+ (should (equal (css--format-rgba-alpha 1.0) "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")
@@ -295,6 +360,18 @@ css-mode-tests--completions
(insert input ")"))
(should (equal (css--hsl-color) "#ff0000")))))
+(ert-deftest css-test-hex-color ()
+ (should (equal (css--hex-color "#abc") "#abc"))
+ (should (equal (css--hex-color "#abcd") "#abc"))
+ (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
--
2.15.1
next prev parent reply other threads:[~2017-12-10 12:46 UTC|newest]
Thread overview: 12+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-11-26 15:21 bug#29456: [PATCH] Add command for cycling between CSS color formats Simen Heggestøyl
2017-11-26 17:53 ` Tom Tromey
2017-11-27 17:07 ` Eli Zaretskii
2017-11-27 17:41 ` Tom Tromey
2017-11-27 18:11 ` Eli Zaretskii
2017-11-27 18:35 ` Tom Tromey
2017-11-27 18:43 ` Eli Zaretskii
2017-11-28 18:33 ` Simen Heggestøyl
2017-11-28 20:57 ` Simen Heggestøyl
2017-12-10 12:46 ` Simen Heggestøyl [this message]
2017-12-10 18:09 ` Eli Zaretskii
2017-12-17 9:32 ` Simen Heggestøyl
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1512909974.15208.0@smtp.gmail.com \
--to=simenheg@gmail.com \
--cc=29456@debbugs.gnu.org \
--cc=monnier@iro.umontreal.ca \
--cc=tom@tromey.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.