bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#25525: 25.1.90; add color highlighting to css mode


From: Tom Tromey
Subject: bug#25525: 25.1.90; add color highlighting to css mode
Date: Wed, 25 Jan 2017 16:24:50 -0700
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/25.1.90 (gnu/linux)

Simen> Thanks Tom, this looks to be a very nice addition to CSS mode!
Simen> Some comments:
[...]

I think this version addresses all the review comments.

This necessitated changing the syntax table a bit.  Now things like
"#red" appear as a symbol, but "<red" appears as punctuation followed by
a word.

Tom

commit c544f57e5102fb19ab06bea6eb2cfeda5b839890
Author: Tom Tromey <address@hidden>
Date:   Wed Jan 25 00:53:49 2017 -0700

    add color highlighting to css-mode
    
    * lisp/textmodes/css-mode.el (css--color-map): New constant.
    (css-value-class-alist): Use css--color-map.
    (css--number-regexp, css--percent-regexp)
    (css--number-or-percent-regexp, css--angle-regexp): New constants.
    (css--color-skip-blanks, css--rgb-color, css--hsl-color): New
    functions.
    (css--colors-regexp): New constant.
    (css--hex-color, css--compute-color, css--contrasty-color)
    (css--fontify-colors): New functions.
    (css-mode): Register css--fontify-colors with jit-lock.
    (css-mode-syntax-table): Set syntax on more characters.
    (css-fontify-colors): New defcustom.
    * test/lisp/textmodes/css-mode-tests.el (css-test-property-values):
    Update.
    (css-test-rgb-parser, css-test-hsl-parser): New tests.
    * etc/NEWS: Add entry.

diff --git a/etc/NEWS b/etc/NEWS
index ca66df6..73ef1de 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -603,6 +603,11 @@ HTML tags, classes and IDs using the 'completion-at-point' 
command.
 Completion candidates for HTML classes and IDs are retrieved from open
 HTML mode buffers.
 
+---
+*** CSS colors are fontified using the color they represent as the
+background.  For instance, #ff0000 would be fontified with a red
+background.
+
 +++
 ** Emacs now supports character name escape sequences in character and
 string literals.  The syntax variants \N{character name} and
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index c81c3f6..0f6c996 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -32,6 +32,8 @@
 
 ;;; Code:
 
+(require 'cl-lib)
+(require 'color)
 (require 'seq)
 (require 'sgml-mode)
 (require 'smie)
@@ -453,8 +455,157 @@ css-property-ids
   (mapcar #'car css-property-alist)
   "Identifiers for properties.")
 
+(defconst css--color-map
+  '(("black" . "#000000")
+    ("silver" . "#c0c0c0")
+    ("gray" . "#808080")
+    ("white" . "#ffffff")
+    ("maroon" . "#800000")
+    ("red" . "#ff0000")
+    ("purple" . "#800080")
+    ("fuchsia" . "#ff00ff")
+    ("green" . "#008000")
+    ("lime" . "#00ff00")
+    ("olive" . "#808000")
+    ("yellow" . "#ffff00")
+    ("navy" . "#000080")
+    ("blue" . "#0000ff")
+    ("teal" . "#008080")
+    ("aqua" . "#00ffff")
+    ("orange" . "#ffa500")
+    ("aliceblue" . "#f0f8ff")
+    ("antiquewhite" . "#faebd7")
+    ("aquamarine" . "#7fffd4")
+    ("azure" . "#f0ffff")
+    ("beige" . "#f5f5dc")
+    ("bisque" . "#ffe4c4")
+    ("blanchedalmond" . "#ffebcd")
+    ("blueviolet" . "#8a2be2")
+    ("brown" . "#a52a2a")
+    ("burlywood" . "#deb887")
+    ("cadetblue" . "#5f9ea0")
+    ("chartreuse" . "#7fff00")
+    ("chocolate" . "#d2691e")
+    ("coral" . "#ff7f50")
+    ("cornflowerblue" . "#6495ed")
+    ("cornsilk" . "#fff8dc")
+    ("crimson" . "#dc143c")
+    ("darkblue" . "#00008b")
+    ("darkcyan" . "#008b8b")
+    ("darkgoldenrod" . "#b8860b")
+    ("darkgray" . "#a9a9a9")
+    ("darkgreen" . "#006400")
+    ("darkgrey" . "#a9a9a9")
+    ("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")
+    ("gainsboro" . "#dcdcdc")
+    ("ghostwhite" . "#f8f8ff")
+    ("gold" . "#ffd700")
+    ("goldenrod" . "#daa520")
+    ("greenyellow" . "#adff2f")
+    ("grey" . "#808080")
+    ("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")
+    ("lightgreen" . "#90ee90")
+    ("lightgrey" . "#d3d3d3")
+    ("lightpink" . "#ffb6c1")
+    ("lightsalmon" . "#ffa07a")
+    ("lightseagreen" . "#20b2aa")
+    ("lightskyblue" . "#87cefa")
+    ("lightslategray" . "#778899")
+    ("lightslategrey" . "#778899")
+    ("lightsteelblue" . "#b0c4de")
+    ("lightyellow" . "#ffffe0")
+    ("limegreen" . "#32cd32")
+    ("linen" . "#faf0e6")
+    ("mediumaquamarine" . "#66cdaa")
+    ("mediumblue" . "#0000cd")
+    ("mediumorchid" . "#ba55d3")
+    ("mediumpurple" . "#9370db")
+    ("mediumseagreen" . "#3cb371")
+    ("mediumslateblue" . "#7b68ee")
+    ("mediumspringgreen" . "#00fa9a")
+    ("mediumturquoise" . "#48d1cc")
+    ("mediumvioletred" . "#c71585")
+    ("midnightblue" . "#191970")
+    ("mintcream" . "#f5fffa")
+    ("mistyrose" . "#ffe4e1")
+    ("moccasin" . "#ffe4b5")
+    ("navajowhite" . "#ffdead")
+    ("oldlace" . "#fdf5e6")
+    ("olivedrab" . "#6b8e23")
+    ("orangered" . "#ff4500")
+    ("orchid" . "#da70d6")
+    ("palegoldenrod" . "#eee8aa")
+    ("palegreen" . "#98fb98")
+    ("paleturquoise" . "#afeeee")
+    ("palevioletred" . "#db7093")
+    ("papayawhip" . "#ffefd5")
+    ("peachpuff" . "#ffdab9")
+    ("peru" . "#cd853f")
+    ("pink" . "#ffc0cb")
+    ("plum" . "#dda0dd")
+    ("powderblue" . "#b0e0e6")
+    ("rosybrown" . "#bc8f8f")
+    ("royalblue" . "#4169e1")
+    ("saddlebrown" . "#8b4513")
+    ("salmon" . "#fa8072")
+    ("sandybrown" . "#f4a460")
+    ("seagreen" . "#2e8b57")
+    ("seashell" . "#fff5ee")
+    ("sienna" . "#a0522d")
+    ("skyblue" . "#87ceeb")
+    ("slateblue" . "#6a5acd")
+    ("slategray" . "#708090")
+    ("slategrey" . "#708090")
+    ("snow" . "#fffafa")
+    ("springgreen" . "#00ff7f")
+    ("steelblue" . "#4682b4")
+    ("tan" . "#d2b48c")
+    ("thistle" . "#d8bfd8")
+    ("tomato" . "#ff6347")
+    ("turquoise" . "#40e0d0")
+    ("violet" . "#ee82ee")
+    ("wheat" . "#f5deb3")
+    ("whitesmoke" . "#f5f5f5")
+    ("yellowgreen" . "#9acd32")
+    ("rebeccapurple" . "#663399"))
+  "Map CSS named color to their hex RGB value.")
+
 (defconst css-value-class-alist
-  '((absolute-size
+  `((absolute-size
      "xx-small" "x-small" "small" "medium" "large" "x-large"
      "xx-large")
     (alphavalue number)
@@ -506,36 +657,7 @@ css-value-class-alist
     (line-width length "thin" "medium" "thick")
     (linear-gradient "linear-gradient()")
     (margin-width "auto" length percentage)
-    (named-color
-     "aliceblue" "antiquewhite" "aqua" "aquamarine" "azure" "beige"
-     "bisque" "black" "blanchedalmond" "blue" "blueviolet" "brown"
-     "burlywood" "cadetblue" "chartreuse" "chocolate" "coral"
-     "cornflowerblue" "cornsilk" "crimson" "cyan" "darkblue"
-     "darkcyan" "darkgoldenrod" "darkgray" "darkgreen" "darkkhaki"
-     "darkmagenta" "darkolivegreen" "darkorange" "darkorchid"
-     "darkred" "darksalmon" "darkseagreen" "darkslateblue"
-     "darkslategray" "darkturquoise" "darkviolet" "deeppink"
-     "deepskyblue" "dimgray" "dodgerblue" "firebrick" "floralwhite"
-     "forestgreen" "fuchsia" "gainsboro" "ghostwhite" "gold"
-     "goldenrod" "gray" "green" "greenyellow" "honeydew" "hotpink"
-     "indianred" "indigo" "ivory" "khaki" "lavender" "lavenderblush"
-     "lawngreen" "lemonchiffon" "lightblue" "lightcoral" "lightcyan"
-     "lightgoldenrodyellow" "lightgray" "lightgreen" "lightpink"
-     "lightsalmon" "lightseagreen" "lightskyblue" "lightslategray"
-     "lightsteelblue" "lightyellow" "lime" "limegreen" "linen"
-     "magenta" "maroon" "mediumaquamarine" "mediumblue" "mediumorchid"
-     "mediumpurple" "mediumseagreen" "mediumslateblue"
-     "mediumspringgreen" "mediumturquoise" "mediumvioletred"
-     "midnightblue" "mintcream" "mistyrose" "moccasin" "navajowhite"
-     "navy" "oldlace" "olive" "olivedrab" "orange" "orangered"
-     "orchid" "palegoldenrod" "palegreen" "paleturquoise"
-     "palevioletred" "papayawhip" "peachpuff" "peru" "pink" "plum"
-     "powderblue" "purple" "rebeccapurple" "red" "rosybrown"
-     "royalblue" "saddlebrown" "salmon" "sandybrown" "seagreen"
-     "seashell" "sienna" "silver" "skyblue" "slateblue" "slategray"
-     "snow" "springgreen" "steelblue" "tan" "teal" "thistle" "tomato"
-     "turquoise" "violet" "wheat" "white" "whitesmoke" "yellow"
-     "yellowgreen")
+    (named-color . ,(mapcar #'car css--color-map))
     (number "calc()")
     (numeric-figure-values "lining-nums" "oldstyle-nums")
     (numeric-fraction-values "diagonal-fractions" "stacked-fractions")
@@ -614,11 +736,23 @@ css-mode-syntax-table
     (modify-syntax-entry ?\[ "(]" st)
     (modify-syntax-entry ?\] ")[" st)
     ;; Special chars that sometimes come at the beginning of words.
-    (modify-syntax-entry ?@ "'" st)
-    ;; (modify-syntax-entry ?: "'" st)
-    (modify-syntax-entry ?# "'" st)
+    ;; We'll treat them as symbol constituents.
+    (modify-syntax-entry ?@ "_" st)
+    (modify-syntax-entry ?# "_" st)
+    (modify-syntax-entry ?. "_" st)
     ;; Distinction between words and symbols.
     (modify-syntax-entry ?- "_" st)
+
+    (modify-syntax-entry ?! "." st)
+    (modify-syntax-entry ?$ "." st)
+    (modify-syntax-entry ?% "." st)
+    (modify-syntax-entry ?& "." st)
+    (modify-syntax-entry ?+ "." st)
+    (modify-syntax-entry ?, "." st)
+    (modify-syntax-entry ?< "." st)
+    (modify-syntax-entry ?> "." st)
+    (modify-syntax-entry ?= "." st)
+    (modify-syntax-entry ?? "." st)
     st))
 
 (eval-and-compile
@@ -726,6 +860,206 @@ css-font-lock-keywords
 (defvar css-font-lock-defaults
   '(css-font-lock-keywords nil t))
 
+(defconst css--number-regexp
+  "\\(\\(?:[0-9]*\\.[0-9]+\\(?:[eE][0-9]+\\)?\\)\\|[0-9]+\\)"
+  "A regular expression matching a CSS number.")
+
+(defconst css--percent-regexp "\\([0-9]+\\)%"
+  "A regular expression matching a CSS percentage.")
+
+(defconst css--number-or-percent-regexp
+  (concat "\\(?:" css--percent-regexp "\\)\\|\\(?:" css--number-regexp "\\)")
+  "A regular expression matching a CSS number or a CSS percentage.")
+
+(defconst css--angle-regexp
+  (concat css--number-regexp
+         (regexp-opt '("deg" "grad" "rad" "turn") t)
+         "?")
+  "A regular expression matching a CSS angle.")
+
+(defun css--color-skip-blanks ()
+  "Skip blanks and comments."
+  (while (forward-comment 1)))
+
+(cl-defun css--rgb-color ()
+  "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."
+  (let ((result '())
+       (iter 0))
+    (while (< iter 4)
+      (css--color-skip-blanks)
+      (unless (looking-at css--number-or-percent-regexp)
+       (cl-return-from css--css-4-rgb nil))
+      (let* ((is-percent (match-beginning 1))
+            (str (match-string (if is-percent 1 2)))
+            (number (string-to-number str)))
+       (when is-percent
+         (setq number (* 255 (/ number 100.0))))
+        ;; Don't push the alpha.
+        (when (< iter 3)
+          (push (min (max 0 (truncate number)) 255) result))
+       (goto-char (match-end 0))
+       (css--color-skip-blanks)
+       (cl-incf iter)
+       ;; Accept a superset of the CSS syntax since I'm feeling lazy.
+       (when (and (= (skip-chars-forward ",/") 0)
+                  (= iter 3))
+         ;; The alpha is optional.
+         (cl-incf iter))
+       (css--color-skip-blanks)))
+    (when (looking-at ")")
+      (forward-char)
+      (apply #'format "#%02x%02x%02x" (nreverse result)))))
+
+(cl-defun css--hsl-color ()
+  "Parse a CSS hsl() or hsla() 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."
+  (let ((result '()))
+    ;; First parse the hue.
+    (css--color-skip-blanks)
+    (unless (looking-at css--angle-regexp)
+      (cl-return-from css--hsl-color nil))
+    (let ((hue (string-to-number (match-string 1)))
+         (unit (match-string 2)))
+      (goto-char (match-end 0))
+      ;; Note that here "turn" is just passed through.
+      (cond
+       ((or (not unit) (equal unit "deg"))
+       ;; Degrees.
+       (setq hue (/ hue 360.0)))
+       ((equal unit "grad")
+       (setq hue (/ hue 400.0)))
+       ((equal unit "rad")
+       (setq hue (/ hue (* 2 float-pi)))))
+      (push (mod hue 1.0) result))
+    (dotimes (_ 2)
+      (skip-chars-forward ",")
+      (css--color-skip-blanks)
+      (unless (looking-at css--percent-regexp)
+        (cl-return-from css--hsl-color nil))
+      (let ((number (string-to-number (match-string 1))))
+        (setq number (/ number 100.0))
+        (push (min (max number 0.0) 1.0) result)
+        (goto-char (match-end 0))
+        (css--color-skip-blanks)))
+    (css--color-skip-blanks)
+    ;; Accept a superset of the CSS syntax since I'm feeling lazy.
+    (when (> (skip-chars-forward ",/") 0)
+      (css--color-skip-blanks)
+      (unless (looking-at css--number-or-percent-regexp)
+        (cl-return-from css--hsl-color nil))
+      (goto-char (match-end 0))
+      (css--color-skip-blanks))
+    (when (looking-at ")")
+      (forward-char)
+      (apply #'color-rgb-to-hex
+            (apply #'color-hsl-to-rgb (nreverse result))))))
+
+(defconst css--colors-regexp
+  (concat
+   ;; Named colors.
+   (regexp-opt (mapcar #'car css--color-map) 'symbols)
+   "\\|"
+   ;; Short hex.  css-color-4 adds alpha.
+   "\\(#[0-9a-fA-F]\\{3,4\\}\\b\\)"
+   "\\|"
+   ;; Long hex.  css-color-4 adds alpha.
+   "\\(#\\(?:[0-9a-fA-F][0-9a-fA-F]\\)\\{3,4\\}\\b\\)"
+   "\\|"
+   ;; RGB.
+   "\\(\\_<rgba?(\\)"
+   "\\|"
+   ;; HSL.
+   "\\(\\_<hsla?(\\)")
+  "A regular expression that matches the start of a CSS color.")
+
+(defun css--hex-color (str)
+  "Convert a CSS hex color to an Emacs 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)
+      (substring str 0 7)
+    (substring str 0 4)))
+
+(defun css--compute-color ()
+  "Return the CSS color at point.
+Point should be just after the start of a CSS color, as recognized
+by `css--colors-regexp'.  This function will either return the color,
+as a hex RGB string; or `nil' if no color could be recognized.  When
+this function returns, point will be at the end of the recognized
+color."
+  (let ((match (downcase (match-string 0))))
+    (cond
+     ((eq (aref match 0) ?#)
+      (css--hex-color match))
+     ((member match '("rgb(" "rgba("))
+      (css--rgb-color))
+     ((member match '("hsl(" "hsla("))
+      (css--hsl-color))
+     ;; Evaluate to the color if the name is found.
+     ((cdr (assoc match css--color-map)))
+     (t
+      (error "Invalid case in css--compute-color")))))
+
+(defun css--contrasty-color (name)
+  "Return a color that contrasts with NAME.
+NAME is of any form accepted by `color-name-to-rgb'.
+The returned color will be usable by Emacs and will contrast
+with NAME; in particular so that if NAME is used as a background
+color, the returned color can be used as the foreground and still
+be readable."
+  (let* ((color (color-name-to-rgb name))
+        (red (car color))
+        (green (cadr color))
+        (blue (cl-caddr color))
+        (luma (+ (* 0.299 red) (* 0.587 green) (* 0.114 blue))))
+    (if (> luma 0.5)
+       "black"
+      "white")))
+
+(defcustom css-fontify-colors t
+  "Whether CSS colors should be fontified using the color as the background.
+When non-`nil', a text representing CSS color will be fontified
+such that its background is the color itself.  E.g., #ff0000 will
+be fontified with a red background."
+  :version "26.1"
+  :group 'css
+  :type 'boolean
+  :safe 'booleanp)
+
+(defun css--fontify-colors (start end)
+  "Fontify CSS colors between START and END.
+START and END are buffer positions.
+This function is used via `jit-lock-register'."
+  (when css-fontify-colors
+    (save-excursion
+      (let ((case-fold-search t))
+        (goto-char start)
+        (while (re-search-forward css--colors-regexp end t)
+          ;; Skip comments and strings.
+          (unless (nth 8 (syntax-ppss))
+            (let ((start (match-beginning 0))
+                  (color (css--compute-color)))
+              (when color
+                (with-silent-modifications
+                  ;; Use the color as the background, to make it more
+                  ;; clear.  Use a contrasting color as the foreground,
+                  ;; to make it readable.  Finally, have a small box
+                  ;; using the existing foreground color, to make sure
+                  ;; it stands out a bit from any other text; in
+                  ;; particular this is nice when the color matches the
+                  ;; buffer's background color.
+                  (add-text-properties
+                   start (point)
+                   (list 'face (list :background color
+                                     :foreground (css--contrasty-color color)
+                                     :box '(:line-width -1)))))))))))))
+
 (defcustom css-indent-offset 4
   "Basic size of one indentation step."
   :version "22.2"
@@ -945,6 +1279,7 @@ css-mode
               :backward-token #'css-smie--backward-token)
   (setq-local electric-indent-chars
               (append css-electric-keys electric-indent-chars))
+  (jit-lock-register #'css--fontify-colors)
   (add-hook 'completion-at-point-functions
             #'css-completion-at-point nil 'local))
 
diff --git a/test/lisp/textmodes/css-mode-tests.el 
b/test/lisp/textmodes/css-mode-tests.el
index 6eb32ea..f058bcf 100644
--- a/test/lisp/textmodes/css-mode-tests.el
+++ b/test/lisp/textmodes/css-mode-tests.el
@@ -58,7 +58,7 @@
 
   ;; Check that the `color' property doesn't cause infinite recursion
   ;; because it refers to the value class of the same name.
-  (should (= (length (css--property-values "color")) 147)))
+  (should (= (length (css--property-values "color")) 152)))
 
 (ert-deftest css-test-property-value-cache ()
   "Test that `css--property-value-cache' is in use."
@@ -218,5 +218,40 @@ css-mode-tests--completions
       (should (member "body" completions))
       (should-not (member "article" completions)))))
 
+(ert-deftest css-test-rgb-parser ()
+  (with-temp-buffer
+    (css-mode)
+    (dolist (input '("255, 0, 127"
+                     "255, /* comment */ 0, 127"
+                     "255 0 127"
+                     "255, 0, 127, 0.75"
+                     "255 0 127 / 0.75"
+                     "100%, 0%, 50%"
+                     "100%, 0%, 50%, 0.115"
+                     "100% 0% 50%"
+                     "100% 0% 50% / 0.115"))
+      (erase-buffer)
+      (save-excursion
+        (insert input ")"))
+      (should (equal (css--rgb-color) "#ff007f")))))
+
+(ert-deftest css-test-hsl-parser ()
+  (with-temp-buffer
+    (css-mode)
+    (dolist (input '("0, 100%, 50%"
+                     "0 100% 50%"
+                     "0 /* two */ /* comments */100% 50%"
+                     "0, 100%, 50%, 0.75"
+                     "0 100% 50% / 0.75"
+                     "0deg 100% 50%"
+                     "360deg 100% 50%"
+                     "0rad, 100%, 50%, 0.115"
+                     "0grad, 100%, 50%, 0.115"
+                     "1turn 100% 50% / 0.115"))
+      (erase-buffer)
+      (save-excursion
+        (insert input ")"))
+      (should (equal (css--hsl-color) "#ff0000")))))
+
 (provide 'css-mode-tests)
 ;;; css-mode-tests.el ends here

reply via email to

[Prev in Thread] Current Thread [Next in Thread]