From 1e830c631b4ecd696cca5a6c37534d7eb2b3fec6 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Mon, 23 Aug 2021 17:51:05 -0700 Subject: [PATCH 1/2] Add support for "bright" ANSI colors in ansi-color * lisp/ansi-color.el (ansi-bright-color-names-vector): New defcustom. (ansi-color-bold-is-bright): New defcustom. (ansi-color--find-face): Sort ANSI codes and check 'ansi-color-bold-is-bright'. (ansi-color-apply-sequence): Support bright ANSI colors. (ansi-color--fill-color-map): New function. (ansi-color-make-color-map): Add bright ANSI colors. (ansi-color-get-face-1): Add BRIGHT parameter. * test/lisp/ansi-color-tests.el (ansi-color-apply-on-region-bold-is-bright-test): New function. --- etc/NEWS | 9 +++ lisp/ansi-color.el | 116 ++++++++++++++++++++++++++-------- test/lisp/ansi-color-tests.el | 51 +++++++++++++-- 3 files changed, 142 insertions(+), 34 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 515f8bac56..94e837705d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2659,6 +2659,15 @@ sequences. *** 'comint-delete-output' can now save deleted text in the kill-ring. Interactively, 'C-u C-c C-o' triggers this new optional behavior. +** ansi-color.el + +--- +*** Supports for "bright" color codes. +"Bright" ANSI color codes are now displayed when applying ANSI color +filters using the color values defined in 'ansi-bright-color-names-vector'. +In addition, bold text with regular ANSI colors can be displayed as +"bright" if 'ansi-color-bold-is-bright' is non-nil. + ** ERC --- diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 79b1c9912f..c54d89c293 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -150,6 +150,48 @@ ansi-color-names-vector :version "24.4" ; default colors copied from `xterm-standard-colors' :group 'ansi-colors) +(defcustom ansi-bright-color-names-vector + ["gray30" "red2" "green2" "yellow2" "blue1" "magenta2" "cyan2" "white"] + "Colors used for SGR control sequences determining a \"bright\" color. +This vector holds the colors used for SGR control sequences parameters +90 to 97 (bright foreground colors) and 100 to 107 (brightbackground +colors). + +Parameter Color + 90 100 bright black + 91 101 bright red + 92 102 bright green + 93 103 bright yellow + 94 104 bright blue + 95 105 bright magenta + 96 106 bright cyan + 97 107 bright white + +This vector is used by `ansi-color-make-color-map' to create a color +map. This color map is stored in the variable `ansi-color-map'. + +Each element may also be a cons cell where the car and cdr specify the +foreground and background colors, respectively." + :type '(vector (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color))) + :set 'ansi-color-map-update + :initialize 'custom-initialize-default + :version "28.1" + :group 'ansi-colors) + +(defcustom ansi-color-bold-is-bright nil + "If set to non-nil, combining ANSI bold and a color produces the bright +version of that color." + :type 'boolean + :version "28.1" + :group 'ansi-colors) + (defconst ansi-color-control-seq-regexp ;; See ECMA 48, section 5.4 "Control Sequences". "\e\\[[\x30-\x3F]*[\x20-\x2F]*[\x40-\x7E]" @@ -304,9 +346,14 @@ ansi-color-filter-apply (defun ansi-color--find-face (codes) "Return the face corresponding to CODES." - (let (faces) + ;; Sort the codes in ascending order to guarantee that "bold" comes before + ;; any of the colors. This ensures that `ansi-color-bold-is-bright' is + ;; applied correctly. + (let (faces bright (codes (sort (copy-sequence codes) #'<))) (while codes - (let ((face (ansi-color-get-face-1 (pop codes)))) + (let ((face (ansi-color-get-face-1 (pop codes) bright))) + (when (and ansi-color-bold-is-bright (eq face 'bold)) + (setq bright t)) ;; In the (default underline) face, say, the value of the ;; "underline" attribute of the `default' face wins. (unless (eq face 'default) @@ -570,11 +617,11 @@ ansi-color-apply-sequence For each new code, the following happens: if it is 1-7, add it to the list of codes; if it is 21-25 or 27, delete appropriate -parameters from the list of codes; if it is 30-37 resp. 39, the -foreground color code is replaced or added resp. deleted; if it -is 40-47 resp. 49, the background color code is replaced or added -resp. deleted; any other code is discarded together with the old -codes. Finally, the so changed list of codes is returned." +parameters from the list of codes; if it is 30-37 (or 90-97) resp. 39, +the foreground color code is replaced or added resp. deleted; if it +is 40-47 (or 100-107) resp. 49, the background color code is replaced +or added resp. deleted; any other code is discarded together with the +old codes. Finally, the so changed list of codes is returned." (let ((new-codes (ansi-color-parse-sequence escape-sequence))) (while new-codes (let* ((new (pop new-codes)) @@ -591,7 +638,7 @@ ansi-color-apply-sequence (22 (remq 1 codes)) (25 (remq 6 codes)) (_ codes))))) - ((or 3 4) (let ((r (mod new 10))) + ((or 3 4 9 10) (let ((r (mod new 10))) (unless (= r 8) (let (beg) (while (and codes (/= q (/ (car codes) 10))) @@ -603,6 +650,19 @@ ansi-color-apply-sequence (_ nil))))) codes)) +(defun ansi-color--fill-color-map (map map-index property vector get-color) + "Fill a range of color values from VECTOR and store in MAP. + +Start filling MAP from MAP-INDEX, and make faces for PROPERTY (`foreground' +or `background'). GET-COLOR is a function taking an element of VECTOR and +returning the color value to use." + (mapc + (lambda (e) + (aset map map-index + (ansi-color-make-face property (funcall get-color e))) + (setq map-index (1+ map-index)) ) + vector)) + (defun ansi-color-make-color-map () "Creates a vector of face definitions and returns it. @@ -611,7 +671,7 @@ ansi-color-make-color-map The face definitions are based upon the variables `ansi-color-faces-vector' and `ansi-color-names-vector'." - (let ((map (make-vector 50 nil)) + (let ((map (make-vector 110 nil)) (index 0)) ;; miscellaneous attributes (mapc @@ -620,23 +680,21 @@ ansi-color-make-color-map (setq index (1+ index)) ) ansi-color-faces-vector) ;; foreground attributes - (setq index 30) - (mapc - (lambda (e) - (aset map index - (ansi-color-make-face 'foreground - (if (consp e) (car e) e))) - (setq index (1+ index)) ) - ansi-color-names-vector) + (ansi-color--fill-color-map + map 30 'foreground ansi-color-names-vector + (lambda (e) (if (consp e) (car e) e))) ;; background attributes - (setq index 40) - (mapc - (lambda (e) - (aset map index - (ansi-color-make-face 'background - (if (consp e) (cdr e) e))) - (setq index (1+ index)) ) - ansi-color-names-vector) + (ansi-color--fill-color-map + map 40 'background ansi-color-names-vector + (lambda (e) (if (consp e) (cdr e) e))) + ;; bright foreground attributes + (ansi-color--fill-color-map + map 90 'foreground ansi-bright-color-names-vector + (lambda (e) (if (consp e) (car e) e))) + ;; bright background attributes + (ansi-color--fill-color-map + map 100 'background ansi-bright-color-names-vector + (lambda (e) (if (consp e) (cdr e) e))) map)) (defvar ansi-color-map (ansi-color-make-color-map) @@ -660,9 +718,13 @@ ansi-color-map-update (set-default symbol value) (setq ansi-color-map (ansi-color-make-color-map))) -(defun ansi-color-get-face-1 (ansi-code) +(defun ansi-color-get-face-1 (ansi-code &optional bright) "Get face definition from `ansi-color-map'. -ANSI-CODE is used as an index into the vector." +ANSI-CODE is used as an index into the vector. BRIGHT, if non-nil, +requests \"bright\" ANSI colors, even if ANSI-CODE is a normal-intensity +color." + (when (and bright (<= 30 ansi-code 49)) + (setq ansi-code (+ ansi-code 60))) (condition-case nil (aref ansi-color-map ansi-code) (args-out-of-range nil))) diff --git a/test/lisp/ansi-color-tests.el b/test/lisp/ansi-color-tests.el index 107dc8e400..c94561bda1 100644 --- a/test/lisp/ansi-color-tests.el +++ b/test/lisp/ansi-color-tests.el @@ -25,17 +25,54 @@ ;;; Code: (require 'ansi-color) +(eval-when-compile (require 'cl-lib)) -(defvar test-strings '(("\e[33mHello World\e[0m" . "Hello World") - ("\e[1m\e[3m\e[5mbold italics blink\e[0m" . "bold italics blink"))) +(defvar yellow (aref ansi-color-names-vector 3)) +(defvar bright-yellow (aref ansi-bright-color-names-vector 3)) + +(defvar test-strings + `(("\e[33mHello World\e[0m" "Hello World" + (foreground-color . ,yellow)) + ("\e[43mHello World\e[0m" "Hello World" + (background-color . ,yellow)) + ("\e[93mHello World\e[0m" "Hello World" + (foreground-color . ,bright-yellow)) + ("\e[103mHello World\e[0m" "Hello World" + (background-color . ,bright-yellow)) + ("\e[1;33mHello World\e[0m" "Hello World" + (bold (foreground-color . ,yellow)) + (bold (foreground-color . ,bright-yellow))) + ("\e[33;1mHello World\e[0m" "Hello World" + (bold (foreground-color . ,yellow)) + (bold (foreground-color . ,bright-yellow))) + ("\e[1m\e[33mHello World\e[0m" "Hello World" + (bold (foreground-color . ,yellow)) + (bold (foreground-color . ,bright-yellow))) + ("\e[33m\e[1mHello World\e[0m" "Hello World" + (bold (foreground-color . ,yellow)) + (bold (foreground-color . ,bright-yellow))) + ("\e[1m\e[3m\e[5mbold italics blink\e[0m" "bold italics blink" + (bold italic success)))) (ert-deftest ansi-color-apply-on-region-test () - (dolist (pair test-strings) - (with-temp-buffer - (insert (car pair)) + (pcase-dolist (`(,input ,text ,face) test-strings) + (with-temp-buffer + (insert input) + (ansi-color-apply-on-region (point-min) (point-max)) + (should (equal (buffer-string) text)) + (should (equal (get-char-property (point-min) 'face) face)) + (should (not (equal (overlays-at (point-min)) nil)))))) + +(ert-deftest ansi-color-apply-on-region-bold-is-bright-test () + (pcase-dolist (`(,input ,text ,face ,bright-face) test-strings) + (with-temp-buffer + (let ((ansi-color-bold-is-bright t)) + (insert input) (ansi-color-apply-on-region (point-min) (point-max)) - (should (equal (buffer-string) (cdr pair))) - (should (not (equal (overlays-at (point-min)) nil)))))) + (should (equal (buffer-string) text)) + (should (equal (get-char-property (point-min) 'face) + (or bright-face face))) + (should (not (equal (overlays-at (point-min)) nil))))))) (ert-deftest ansi-color-apply-on-region-preserving-test () (dolist (pair test-strings) -- 2.25.1