--- /dev/null
+;;; rainbow.el --- Colorize color names in buffers -*- lexical-binding: t -*-
+
+;; Copyright (C) 2024 Free Software Foundation, Inc
+
+;; Keywords: faces
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This minor mode sets background color to strings that match color
+;; names, e.g. #0000ff is displayed in white with a blue background.
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'regexp-opt)
+(require 'faces)
+(require 'color)
+
+(defgroup rainbow nil
+ "Show color strings with a background color."
+ :tag "Rainbow"
+ :group 'help)
+
+;;; Hexadecimal colors
+
+(defvar rainbow-hexadecimal-colors-font-lock-keywords
+ '(("[^&]\\(#\\(?:[0-9a-fA-F]\\{3\\}\\)\\{1,4\\}\\)\\b"
+ (1 (rainbow-colorize-itself 1)))
+ ("^\\(#\\(?:[0-9a-fA-F]\\{3\\}\\)\\{1,4\\}\\)\\b"
+ (0 (rainbow-colorize-itself)))
+ ("[Rr][Gg][Bb]:[0-9a-fA-F]\\{1,4\\}/[0-9a-fA-F]\\{1,4\\}/[0-9a-fA-F]\\{1,4\\}"
+ (0 (rainbow-colorize-itself)))
+ ("[Rr][Gg][Bb][Ii]:[0-9.]+/[0-9.]+/[0-9.]+"
+ (0 (rainbow-colorize-itself)))
+ ("\\(?:[Cc][Ii][Ee]\\(?:[Xx][Yy][Zz]\\|[Uu][Vv][Yy]\\|[Xx][Yy][Yy]\\|[Ll][Aa][Bb]\\|[Ll][Uu][Vv]\\)\\|[Tt][Ee][Kk][Hh][Vv][Cc]\\):[+-]?[0-9.]+\\(?:[Ee][+-]?[0-9]+\\)?/[+-]?[0-9.]+\\(?:[Ee][+-]?[0-9]+\\)?/[+-]?[0-9.]+\\(?:[Ee][+-]?[0-9]+\\)?"
+ (0 (rainbow-colorize-itself))))
+ "Font-lock keywords to add for hexadecimal colors.")
+
+;;; X colors
+
+(defvar rainbow-x-colors-font-lock-keywords
+ `((,(regexp-opt (defined-colors) 'words)
+ (0 (rainbow-colorize-itself))))
+ "Font-lock keywords to add for X colors.")
+
+(defcustom rainbow-x-colors-major-mode-list
+ '(emacs-lisp-mode lisp-interaction-mode c-mode c++-mode java-mode)
+ "Modes in which to enable X colors when `rainbow-x-colors' is `auto'."
+ :type '(repeat (symbol :tag "Major-Mode"))
+ :group 'rainbow)
+
+(defcustom rainbow-x-colors 'auto
+ "When to enable X colors.
+If set to t, the X colors will be enabled. If set to nil, the
+X colors will not be enabled. If set to auto, the X colors
+will be enabled if a major mode has been detected from the
+`rainbow-x-colors-major-mode-list'."
+ :type '(choice (symbol :tag "enable in certain modes" auto)
+ (symbol :tag "enable globally" t)
+ (symbol :tag "disable" nil))
+ :group 'rainbow)
+
+;;; Functions
+
+(defun rainbow-colorize-match (color &optional match)
+ "Return a matched string propertized with a face whose background is COLOR.
+
+The foreground is computed using `rainbow-color-luminance', and is
+either white or black.
+
+MATCH in the subgroup number to use, defaulting to 0."
+ (let ((match (or match 0)))
+ (put-text-property
+ (match-beginning match) (match-end match)
+ 'face `((:foreground ,(if (> 0.5 (rainbow-x-color-luminance color))
+ "white" "black"))
+ (:background ,color)))))
+
+(defun rainbow-colorize-itself (&optional match)
+ "Colorize a match with itself.
+
+MATCH in the subgroup number to use, defaulting to 0."
+ (rainbow-colorize-match (match-string-no-properties (or match 0)) match))
+
+(defun rainbow-colorize-hexadecimal-without-sharp ()
+ "Colorize an hexadecimal colors and prepend # to it."
+ (rainbow-colorize-match (concat "#" (match-string-no-properties 1))))
+
+(defun rainbow-colorize-by-assoc (assoc-list)
+ "Colorize a match with its association from ASSOC-LIST."
+ (rainbow-colorize-match (cdr (assoc-string (match-string-no-properties 0)
+ assoc-list t))))
+
+(defun rainbow-rgb-relative-to-absolute (number)
+ "Convert a relative NUMBER to absolute. If NUMBER is absolute, return NUMBER.
+This will convert \"80 %\" to 204, \"100 %\" to 255 but \"123\" to \"123\".
+If the percentage value is above 100, it's converted to 100."
+ (let ((string-length (- (length number) 1)))
+ ;; Is this a number with %?
+ (if (eq (elt number string-length) ?%)
+ (/ (* (min (string-to-number (substring number 0 string-length)) 100) 255) 100)
+ (string-to-number number))))
+
+(defun rainbow-colorize-hsl ()
+ "Colorize a match with itself."
+ (let ((h (/ (string-to-number (match-string-no-properties 1)) 360.0))
+ (s (/ (string-to-number (match-string-no-properties 2)) 100.0))
+ (l (/ (string-to-number (match-string-no-properties 3)) 100.0)))
+ (rainbow-colorize-match
+ (cl-destructuring-bind (r g b)
+ (color-hsl-to-rgb h s l)
+ (format "#%02X%02X%02X" (* r 255) (* g 255) (* b 255))))))
+
+(defun rainbow-colorize-rgb ()
+ "Colorize a match with itself."
+ (let ((r (rainbow-rgb-relative-to-absolute (match-string-no-properties 1)))
+ (g (rainbow-rgb-relative-to-absolute (match-string-no-properties 2)))
+ (b (rainbow-rgb-relative-to-absolute (match-string-no-properties 3))))
+ (rainbow-colorize-match (format "#%02X%02X%02X" r g b))))
+
+(defun rainbow-colorize-rgb-float ()
+ "Colorize a match with itself, with relative value."
+ (let ((r (* (string-to-number (match-string-no-properties 1)) 255.0))
+ (g (* (string-to-number (match-string-no-properties 2)) 255.0))
+ (b (* (string-to-number (match-string-no-properties 3)) 255.0)))
+ (rainbow-colorize-match (format "#%02X%02X%02X" r g b))))
+
+(defun rainbow-color-luminance (red green blue)
+ "Calculate the relative luminance of color composed of RED, GREEN and BLUE.
+Return a value between 0 and 1."
+ (/ (+ (* .2126 red) (* .7152 green) (* .0722 blue)) 255))
+
+(defun rainbow-x-color-luminance (color)
+ "Calculate the relative luminance of a COLOR, a string.
+Return a value between 0 and 1."
+ (let* ((values (color-values color))
+ (r (/ (car values) 256.0))
+ (g (/ (cadr values) 256.0))
+ (b (/ (caddr values) 256.0)))
+ (rainbow-color-luminance r g b)))
+
+;;; Mode
+
+(defun rainbow-turn-on ()
+ "Turn on `rainbow-mode'."
+ (font-lock-add-keywords nil
+ rainbow-hexadecimal-colors-font-lock-keywords
+ t)
+ ;; Activate X colors?
+ (when (or (eq rainbow-x-colors t)
+ (and (eq rainbow-x-colors 'auto)
+ (memq major-mode rainbow-x-colors-major-mode-list)))
+ (font-lock-add-keywords nil
+ rainbow-x-colors-font-lock-keywords
+ t)))
+
+(defun rainbow-turn-off ()
+ "Turn off `rainbow-mode'."
+ (font-lock-remove-keywords
+ nil
+ `(,@rainbow-hexadecimal-colors-font-lock-keywords
+ ,@rainbow-x-colors-font-lock-keywords)))
+
+;;;###autoload
+(define-minor-mode rainbow-mode
+ "Colorize strings that represent colors.
+This highlights strings such as \"#aabbcc\" or \"blue\" with their
+corresponding colors."
+ :lighter " Rbow"
+ (if rainbow-mode (rainbow-turn-on) (rainbow-turn-off))
+ (font-lock-mode 1))
+
+(provide 'rainbow-mode)
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
+;;; rainbow.el ends here
projects / emacs.git / commitdiff