From 497f407f521a98033cd99c5024319fea1c1718d2 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 13 Jul 2024 20:46:26 +0200 Subject: [PATCH] * lisp/rainbow.el: New file. Extracted from https://github.com/emacsmirror/rainbow-mode --- lisp/rainbow.el | 194 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 194 insertions(+) create mode 100644 lisp/rainbow.el diff --git a/lisp/rainbow.el b/lisp/rainbow.el new file mode 100644 index 00000000000..9017980341d --- /dev/null +++ b/lisp/rainbow.el @@ -0,0 +1,194 @@ +;;; 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 . + +;;; 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 -- 2.39.2