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

From: Tom Tromey <[email-masked]>
Date: Sat, 04 Mar 2017 10:55:45 -0700

Simen> Unfortunately I'm still experiencing the bug with that version
Simen> too.

I was able to reproduce the problem and I think I found the bug:
css--fontify-region was not respecting any region extension done by
font-lock-default-fontify-region, but this is what extended
fontification to include the whole line containing point when searching.

Please try this version.

Tom

diff --git a/etc/NEWS b/etc/NEWS
index a8db54c..ae2ac3e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -668,6 +668,11 @@ pseudo-element, with the default being guessed from context).  By
 default the information is looked up on the Mozilla Developer Network,
 but this can be customized using 'css-lookup-url-format'.
 
+---
+*** 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 7a9454f..8cec7ca 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -33,6 +33,8 @@
 ;;; Code:
 
 (require 'eww)
+(require 'cl-lib)
+(require 'color)
 (require 'seq)
 (require 'sgml-mode)
 (require 'smie)
@@ -455,8 +457,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)
@@ -508,36 +659,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")
@@ -616,11 +738,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))
 
 (defvar css-mode-map
@@ -735,6 +869,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-distance'.
+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."
+  ;; See bug#25525 for a discussion of this.
+  (if (> (color-distance name "black") 292485)
+      "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-region (start end &optional loudly)
+  "Fontify a CSS buffer between START and END.
+START and END are buffer positions."
+  (let ((extended-region (font-lock-default-fontify-region start end loudly)))
+    (when css-fontify-colors
+      (when (and (consp extended-region)
+		 (eq (car extended-region) 'jit-lock-bounds))
+	(setq start (cadr extended-region))
+	(setq end (cddr extended-region)))
+      (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))))))))))))
+    extended-region))
+
 (defcustom css-indent-offset 4
   "Basic size of one indentation step."
   :version "22.2"
@@ -1001,6 +1335,7 @@ css-mode
               :backward-token #'css-smie--backward-token)
   (setq-local electric-indent-chars
               (append css-electric-keys electric-indent-chars))
+  (setq-local font-lock-fontify-region-function #'css--fontify-region)
   (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 d601f43..5fa4ae2 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."
@@ -234,5 +234,40 @@ css-mode-tests--completions
       (save-excursion (insert (nth 1 item)))
       (should (equal (nth 2 item) (css--mdn-find-symbol))))))
 
+(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