unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Jim Porter <jporterbugs@gmail.com>
To: Lars Ingebrigtsen <larsi@gnus.org>
Cc: 50179@debbugs.gnu.org
Subject: bug#50179: [PATCH v4] Add support for "bright" ANSI colors to ansi-color and term-mode
Date: Wed, 22 Sep 2021 18:47:25 -0700	[thread overview]
Message-ID: <24dfacb5-067d-580d-2608-8198d9e4f1a3@gmail.com> (raw)
In-Reply-To: <87ilysv1a4.fsf@gnus.org>

[-- Attachment #1: Type: text/plain, Size: 1181 bytes --]

On 9/22/2021 12:49 PM, Lars Ingebrigtsen wrote:
> Jim Porter <jporterbugs@gmail.com> writes:
> 
>> I don't quite know what to do about man.el though. It has overrides
>> for a few of the faces used by ansi-color. I could maintain that
>> behavior fairly easily, but maybe it makes sense to have it use the
>> defaults from ansi-color.
> 
> Hm...  I wonder why man.el is overriding the colours?

Since I'm not totally sure, I maintained that behavior. It's not really 
any extra effort, so someone can make that decision later.

> Skimming the patch, it looks good to me, but some trivial comments:
> 
>> -(defcustom ansi-color-faces-vector
>> -  [default bold default italic underline success warning error]
> 
> Instead of removing the variable, mark it as obsolete instead.  (Users
> may have code that references it in their .emacs files, and that
> shouldn't bug out.)

Ok, I've done this here, and all the other places as well. I also 
obsoleted the old `ansi-color-map' and friends instead of deleting them 
for the same reason. Hopefully all that's right; I tried to make sure 
that they warn the user if they use them, but that warnings don't show 
up when building Emacs.

[-- Attachment #2: 0001-Add-support-for-bright-ANSI-colors-in-ansi-color.patch --]
[-- Type: text/plain, Size: 23175 bytes --]

From 7083f0be951f3100c3a3249313ede7391df09281 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Wed, 22 Sep 2021 18:37:52 -0700
Subject: [PATCH 1/2] Add support for "bright" ANSI colors in ansi-color

* lisp/ansi-color.el (ansi-color-bold, ansi-color-faint, ansi-color-italic)
(ansi-color-underline, ansi-color-slow-blink, ansi-color-fast-blink)
(ansi-color-inverse, ansi-color-red, ansi-color-green, ansi-color-yellow)
(ansi-color-blue, ansi-color-magenta, ansi-color-cyan, ansi-color-white)
(ansi-color-bright-red, ansi-color-bright-green, ansi-color-bright-yellow)
(ansi-color-bright-blue, ansi-color-bright-magenta, ansi-color-bright-cyan)
(ansi-color-bright-white): New faces.
(ansi-color-basic-faces-vector, ansi-color-normal-colors-vector)
(ansi-color-bright-colors-vector): New constants.
(ansi-color-faces-vector, ansi-color-names-vector): Make obsolete.
(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-make-color-map, ansi-color-map, ansi-color-map-update):
Make obsolete.
(ansi-color-get-face-1): Add BRIGHT parameter.
* lisp/man.el (Man-ansi-color-basic-faces-vector): New variable.
(Man-ansi-color-map): Make obsolete.
(Man-fontify-manpage): Use 'Man-ansi-color-basic-faces-vector' here.
* test/lisp/ansi-color-tests.el
(ansi-color-apply-on-region-bold-is-bright-test): New function.
---
 etc/NEWS                      |  15 ++
 lisp/ansi-color.el            | 355 +++++++++++++++++++++++++++-------
 lisp/man.el                   |  22 ++-
 test/lisp/ansi-color-tests.el |  55 +++++-
 4 files changed, 365 insertions(+), 82 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index f273b8e82a..cf6823f51b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2703,6 +2703,21 @@ 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
+
+---
+*** Colors are now defined by faces.
+ANSI SGR codes now have corresponding faces to describe their
+appearance, e.g. 'ansi-color-bold'.
+
+---
+*** Support for "bright" color codes.
+"Bright" ANSI color codes are now displayed when applying ANSI color
+filters using the color values defined by the faces
+'ansi-color-bright-COLOR'.  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 4315a7f3ce..b1c9cdaeca 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -90,53 +90,168 @@ ansi-colors
   :version "21.1"
   :group 'processes)
 
+(defface ansi-color-bold
+  '((t :inherit 'bold))
+  "Face used to render bold text."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-faint
+  '((t :weight light))
+  "Face used to render faint text."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-italic
+  '((t :inherit 'italic))
+  "Face used to render italic text."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-underline
+  '((t :inherit 'underline))
+  "Face used to render underlined text."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-slow-blink
+  '((t :box (:line-width -1)))
+  "Face used to render slowly blinking text."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-fast-blink
+  '((t :box (:line-width -1)))
+  "Face used to render rapidly blinking text."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-inverse
+  '((t :inverse-video t))
+  "Face used to render inverted video text."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-black
+  '((t :foreground "black" :background "black"))
+  "Face used to render black color code."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-red
+  '((t :foreground "red3" :background "red3"))
+  "Face used to render red color code."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-green
+  '((t :foreground "green3" :background "green3"))
+  "Face used to render green color code."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-yellow
+  '((t :foreground "yellow3" :background "yellow3"))
+  "Face used to render yellow color code."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-blue
+  '((t :foreground "blue2" :background "blue2"))
+  "Face used to render blue color code."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-magenta
+  '((t :foreground "magenta3" :background "magenta3"))
+  "Face used to render magenta color code."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-cyan
+  '((t :foreground "cyan3" :background "cyan3"))
+  "Face used to render cyan color code."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-white
+  '((t :foreground "grey90" :background "gray90"))
+  "Face used to render white color code."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-bright-black
+  '((t :foreground "gray30" :background "gray30"))
+  "Face used to render bright black color code."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-bright-red
+  '((t :foreground "red2" :background "red2"))
+  "Face used to render bright red color code."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-bright-green
+  '((t :foreground "green2" :background "green2"))
+  "Face used to render bright green color code."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-bright-yellow
+  '((t :foreground "yellow2" :background "yellow2"))
+  "Face used to render bright yellow color code."
+  :group 'ansi-colors)
+
+(defface ansi-color-bright-blue
+  '((t :foreground "blue1" :background "blue1"))
+  "Face used to render bright blue color code."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-bright-magenta
+  '((t :foreground "magenta2" :background "magenta2"))
+  "Face used to render bright magenta color code."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-bright-cyan
+  '((t :foreground "cyan2" :background "cyan2"))
+  "Face used to render bright cyan color code."
+  :group 'ansi-colors
+  :version "28.1")
+
+(defface ansi-color-bright-white
+  '((t :foreground "white" :background "white"))
+  "Face used to render bright white color code."
+  :group 'ansi-colors
+  :version "28.1")
+
 (defcustom ansi-color-faces-vector
   [default bold default italic underline success warning error]
   "Faces used for SGR control sequences determining a face.
 This vector holds the faces used for SGR control sequence parameters 0
 to 7.
 
-Parameter  Description        Face used by default
-  0        default            default
-  1        bold               bold
-  2        faint              default
-  3        italic             italic
-  4        underlined         underline
-  5        slowly blinking    success
-  6        rapidly blinking   warning
-  7        negative image     error
-
-Note that the symbol `default' is special: It will not be combined
-with the current face.
-
-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'."
+This variable is obsolete.  To customize the display of faces used by
+ansi-color, change 'ansi-color-FACE', e.g. `ansi-color-bold'.  To
+customize the actual faces used (e.g. to temporarily display SGR
+control sequences differently), use `ansi-color-basic-faces-vector'."
   :type '(vector face face face face face face face face)
-  :set 'ansi-color-map-update
-  :initialize 'custom-initialize-default
   :group 'ansi-colors)
+(make-obsolete-variable 'ansi-color-faces-vector 'ansi-color-basic-faces-vector
+                        "28.1")
 
 (defcustom ansi-color-names-vector
   ["black" "red3" "green3" "yellow3" "blue2" "magenta3" "cyan3" "gray90"]
   "Colors used for SGR control sequences determining a color.
-This vector holds the colors used for SGR control sequences parameters
+This vector holds the colors used for SGR control sequence parameters
 30 to 37 (foreground colors) and 40 to 47 (background colors).
 
-Parameter  Color
-  30  40   black
-  31  41   red
-  32  42   green
-  33  43   yellow
-  34  44   blue
-  35  45   magenta
-  36  46   cyan
-  37  47   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."
+This variable is obsolete.  To customize the display of colors used by
+ansi-color, change 'ansi-color-COLOR', e.g. `ansi-color-red'.  To
+customize the actual faces used (e.g. to temporarily display SGR
+control sequences differently), use `ansi-color-normal-colors-vector'."
   :type '(vector (choice color (cons color color))
                  (choice color (cons color color))
                  (choice color (cons color color))
@@ -145,10 +260,87 @@ ansi-color-names-vector
                  (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 "24.4" ; default colors copied from `xterm-standard-colors'
   :group 'ansi-colors)
+(make-obsolete-variable 'ansi-color-faces-vector
+                        'ansi-color-normal-colors-vector "28.1")
+
+(defvar ansi-color-basic-faces-vector
+  [nil
+   ansi-color-bold
+   ansi-color-faint
+   ansi-color-italic
+   ansi-color-underline
+   ansi-color-slow-blink
+   ansi-color-fast-blink
+   ansi-color-inverse]
+  "Faces used for SGR control sequences determining a face.
+This vector holds the faces used for SGR control sequence parameters 0
+to 7.
+
+Parameter  Description
+  0        default
+  1        bold
+  2        faint
+  3        italic
+  4        underlined
+  5        slowly blinking
+  6        rapidly blinking
+  7        negative image")
+
+(defvar ansi-color-normal-colors-vector
+  [ansi-color-black
+   ansi-color-red
+   ansi-color-green
+   ansi-color-yellow
+   ansi-color-blue
+   ansi-color-magenta
+   ansi-color-cyan
+   ansi-color-white]
+  "Faces used for SGR control sequences determining a color.
+This vector holds the faces used for SGR control sequence parameters
+30 to 37 (foreground colors) and 40 to 47 (background colors).
+
+Parameter  Color
+  30  40   black
+  31  41   red
+  32  42   green
+  33  43   yellow
+  34  44   blue
+  35  45   magenta
+  36  46   cyan
+  37  47   white")
+
+(defvar ansi-color-bright-colors-vector
+  [ansi-color-bright-black
+   ansi-color-bright-red
+   ansi-color-bright-green
+   ansi-color-bright-yellow
+   ansi-color-bright-blue
+   ansi-color-bright-magenta
+   ansi-color-bright-cyan
+   ansi-color-bright-white]
+  "Faces used for SGR control sequences determining a \"bright\" color.
+This vector holds the faces used for SGR control sequence parameters
+90 to 97 (bright foreground colors) and 100 to 107 (bright background
+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")
+
+(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".
@@ -304,13 +496,15 @@ 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))))
-	;; In the (default underline) face, say, the value of the
-	;; "underline" attribute of the `default' face wins.
-	(unless (eq face 'default)
-	  (push face faces))))
+      (when-let ((face (ansi-color-get-face-1 (pop codes) bright)))
+        (when (and ansi-color-bold-is-bright (eq face 'ansi-color-bold))
+          (setq bright t))
+        (push face faces)))
     ;; Avoid some long-lived conses in the common case.
     (if (cdr faces)
 	(nreverse faces)
@@ -321,9 +515,8 @@ ansi-color-apply
 Delete all other control sequences without processing them.
 
 Applies SGR control sequences setting foreground and background colors
-to STRING using text properties and returns the result.  The colors used
-are given in `ansi-color-faces-vector' and `ansi-color-names-vector'.
-See function `ansi-color-apply-sequence' for details.
+to STRING using text properties and returns the result.  See function
+`ansi-color-apply-sequence' for details.
 
 Every call to this function will set and use the buffer-local variable
 `ansi-color-context' to save partial escape sequences and current ansi codes.
@@ -402,8 +595,7 @@ ansi-color-apply-on-region
 SGR control sequences are applied by calling the function
 specified by `ansi-color-apply-face-function'.  The default
 function sets foreground and background colors to the text
-between BEGIN and END, using overlays.  The colors used are given
-in `ansi-color-faces-vector' and `ansi-color-names-vector'.  See
+between BEGIN and END, using overlays.  See function
 `ansi-color-apply-sequence' for details.
 
 Every call to this function will set and use the buffer-local
@@ -570,11 +762,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 +783,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)))
@@ -610,7 +802,9 @@ ansi-color-make-color-map
 `ansi-color-map' for an example.
 
 The face definitions are based upon the variables
-`ansi-color-faces-vector' and `ansi-color-names-vector'."
+`ansi-color-faces-vector' and `ansi-color-names-vector'.
+
+This function is obsolete, and no longer needed to use ansi-color."
   (let ((map (make-vector 50 nil))
         (index 0))
     ;; miscellaneous attributes
@@ -638,34 +832,57 @@ ansi-color-make-color-map
        (setq index (1+ index)) )
      ansi-color-names-vector)
     map))
+(make-obsolete 'ansi-color-make-color-map "you can remove it." "28.1")
 
-(defvar ansi-color-map (ansi-color-make-color-map)
-  "A brand new color map suitable for `ansi-color-get-face'.
+(defvar ansi-color-map
+  (with-no-warnings (ansi-color-make-color-map))
+  "A brand new color map, formerly suitable for `ansi-color-get-face'.
 
 The value of this variable is usually constructed by
 `ansi-color-make-color-map'.  The values in the array are such that the
 numbers included in an SGR control sequences point to the correct
 foreground or background colors.
 
-Example: The sequence \\033[34m specifies a blue foreground.  Therefore:
-     (aref ansi-color-map 34)
-          => (foreground-color . \"blue\")")
+This variable is obsolete, and no longer needed to use ansi-color.")
+(make-obsolete-variable 'ansi-color-map "you can remove it." "28.1")
 
 (defun ansi-color-map-update (symbol value)
   "Update `ansi-color-map'.
 
-Whenever the vectors used to construct `ansi-color-map' are changed,
-this function is called.  Therefore this function is listed as the :set
-property of `ansi-color-faces-vector' and `ansi-color-names-vector'."
+This function is obsolete, and no longer needed to use ansi-color."
   (set-default symbol value)
-  (setq ansi-color-map (ansi-color-make-color-map)))
-
-(defun ansi-color-get-face-1 (ansi-code)
-  "Get face definition from `ansi-color-map'.
-ANSI-CODE is used as an index into the vector."
-  (condition-case nil
-      (aref ansi-color-map ansi-code)
-    (args-out-of-range nil)))
+  (with-no-warnings
+    (setq ansi-color-map (ansi-color-make-color-map))))
+(make-obsolete 'ansi-color-map-update "you can remove it." "28.1")
+
+(defun ansi-color-get-face-1 (ansi-code &optional bright)
+  "Get face definition for ANSI-CODE.
+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)))
+  (cond ((<= 0 ansi-code 7)
+         (aref ansi-color-basic-faces-vector ansi-code))
+        ((<= 30 ansi-code 38)
+         (list :foreground
+               (face-foreground
+                (aref ansi-color-normal-colors-vector (- ansi-code 30))
+                nil 'default)))
+        ((<= 40 ansi-code 48)
+         (list :background
+               (face-background
+                (aref ansi-color-normal-colors-vector (- ansi-code 40))
+                nil 'default)))
+        ((<= 90 ansi-code 98)
+         (list :foreground
+               (face-foreground
+                (aref ansi-color-bright-colors-vector (- ansi-code 90))
+                nil 'default)))
+        ((<= 100 ansi-code 108)
+         (list :background
+               (face-background
+                (aref ansi-color-bright-colors-vector (- ansi-code 100))
+                nil 'default)))))
 
 (provide 'ansi-color)
 
diff --git a/lisp/man.el b/lisp/man.el
index 6009a31919..84287c9f9d 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -141,11 +141,21 @@ Man-reverse
   :group 'man
   :version "24.3")
 
-(defvar Man-ansi-color-map (let ((ansi-color-faces-vector
-				  [ default Man-overstrike default Man-underline
-				    Man-underline default default Man-reverse ]))
-			     (ansi-color-make-color-map))
-  "The value used here for `ansi-color-map'.")
+(defvar Man-ansi-color-basic-faces-vector
+  [nil Man-overstrike nil Man-underline Man-underline nil nil Man-reverse]
+  "The value used here for `ansi-color-basic-faces-vector'.")
+
+(defvar Man-ansi-color-map
+  (with-no-warnings
+    (let ((ansi-color-faces-vector Man-ansi-color-basic-faces-vector))
+           [ default Man-overstrike default Man-underline
+             Man-underline default default Man-reverse ]))
+      (ansi-color-make-color-map)))
+  "The value formerly used here for `ansi-color-map'.
+This variable is obsolete.  To customize the faces used by ansi-color,
+set `Man-ansi-color-basic-faces-vector'.")
+(make-obsolete-variable 'Man-ansi-color-map
+                        'Man-ansi-color-basic-faces-vector "28.1")
 
 (defcustom Man-notify-method 'friendly
   "Selects the behavior when manpage is ready.
@@ -1243,7 +1253,7 @@ Man-fontify-manpage
   (goto-char (point-min))
   ;; Fontify ANSI escapes.
   (let ((ansi-color-apply-face-function #'ansi-color-apply-text-property-face)
-	(ansi-color-map Man-ansi-color-map))
+	(ansi-color-basic-faces-vector Man-ansi-color-basic-faces-vector))
     (ansi-color-apply-on-region (point-min) (point-max)))
   ;; Other highlighting.
   (let ((buffer-undo-list t))
diff --git a/test/lisp/ansi-color-tests.el b/test/lisp/ansi-color-tests.el
index 107dc8e400..df674dfc7f 100644
--- a/test/lisp/ansi-color-tests.el
+++ b/test/lisp/ansi-color-tests.el
@@ -25,17 +25,58 @@
 ;;; 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 (face-foreground 'ansi-color-yellow nil 'default))
+(defvar bright-yellow (face-foreground 'ansi-color-bright-yellow nil 'default))
+
+(defvar test-strings
+  `(("Hello World" "Hello World")
+    ("\e[33mHello World\e[0m" "Hello World"
+     (:foreground ,yellow))
+    ("\e[43mHello World\e[0m" "Hello World"
+     (:background ,yellow))
+    ("\e[93mHello World\e[0m" "Hello World"
+     (:foreground ,bright-yellow))
+    ("\e[103mHello World\e[0m" "Hello World"
+     (:background ,bright-yellow))
+    ("\e[1;33mHello World\e[0m" "Hello World"
+     (ansi-color-bold (:foreground ,yellow))
+     (ansi-color-bold (:foreground ,bright-yellow)))
+    ("\e[33;1mHello World\e[0m" "Hello World"
+     (ansi-color-bold (:foreground ,yellow))
+     (ansi-color-bold (:foreground ,bright-yellow)))
+    ("\e[1m\e[33mHello World\e[0m" "Hello World"
+     (ansi-color-bold (:foreground ,yellow))
+     (ansi-color-bold (:foreground ,bright-yellow)))
+    ("\e[33m\e[1mHello World\e[0m" "Hello World"
+     (ansi-color-bold (:foreground ,yellow))
+     (ansi-color-bold (:foreground ,bright-yellow)))
+    ("\e[1m\e[3m\e[5mbold italics blink\e[0m" "bold italics blink"
+     (ansi-color-bold ansi-color-italic ansi-color-slow-blink))
+    ("\e[10munrecognized\e[0m" "unrecognized")))
 
 (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))
+      (when face
+        (should (not (equal (overlays-at (point-min)) nil)))))))
+
+(ert-deftest ansi-color-apply-on-region-bold-is-bright-test ()
+  (pcase-dolist (`(,input ,text ,normal-face ,bright-face) test-strings)
+    (with-temp-buffer
+      (let ((ansi-color-bold-is-bright t)
+            (face (or bright-face normal-face)))
+        (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) face))
+        (when 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


[-- Attachment #3: 0002-Add-support-for-bright-ANSI-colors-in-term-mode.patch --]
[-- Type: text/plain, Size: 14587 bytes --]

From 1669822acaa36201a2b8dd81d93a3c737c8c72d9 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Wed, 22 Sep 2021 18:39:52 -0700
Subject: [PATCH 2/2] Add support for "bright" ANSI colors in term-mode

* list/term.el (ansi-term-color-vector): Add new faces.
(term-color-black, term-color-red, term-color-green, term-color-yellow)
(term-color-blue, term-color-magenta, term-color-cyan, term-color-white):
Inherit from 'ansi-color-COLOR'.
(term-color-bright-black, term-color-bright-red, term-color-bright-green)
(term-color-bright-yellow, term-color-bright-blue)
(term-color-bright-magenta, term-color-bright-cyan)
(term-color-bright-white): New faces.
(term--maybe-brighten-color): New function.
(term-handle-colors-array): Handle bright colors.
* test/lisp/term-tests.el (term-colors, term-colors-bold-is-bright):
New functions.
---
 etc/NEWS                |   7 ++
 lisp/term.el            | 189 +++++++++++++++++++++++++++++-----------
 test/lisp/term-tests.el |  65 +++++++++++++-
 3 files changed, 210 insertions(+), 51 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index cf6823f51b..27c6996bb3 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1508,6 +1508,13 @@ based on the current window size.  In previous versions of Emacs, this
 was always done (and that could lead to odd displays when resizing the
 window after starting).  This variable defaults to nil.
 
+---
+*** 'term-mode' now supports "bright" color codes.
+"Bright" ANSI color codes are now displayed using the color values
+defined in 'term-color-bright-*'.  In addition, bold text with regular
+ANSI colors can be displayed as "bright" if 'ansi-color-bold-is-bright'
+is non-nil.
+
 ** Eshell
 
 ---
diff --git a/lisp/term.el b/lisp/term.el
index af93089104..e76eb77647 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -727,7 +727,15 @@ ansi-term-color-vector
    term-color-blue
    term-color-magenta
    term-color-cyan
-   term-color-white])
+   term-color-white
+   term-color-bright-black
+   term-color-bright-red
+   term-color-bright-green
+   term-color-bright-yellow
+   term-color-bright-blue
+   term-color-bright-magenta
+   term-color-bright-cyan
+   term-color-bright-white])
 
 (defcustom term-default-fg-color nil
   "If non-nil, default color for foreground in Term mode."
@@ -752,54 +760,112 @@ term
   :group 'term)
 
 (defface term-bold
-  '((t :bold t))
+  '((t :inherit ansi-color-bold))
   "Default face to use for bold text."
-  :group 'term)
+  :group 'term
+  :version "28.1")
 
 (defface term-underline
-  '((t :underline t))
+  '((t :inherit ansi-color-underline))
   "Default face to use for underlined text."
-  :group 'term)
+  :group 'term
+  :version "28.1")
 
 (defface term-color-black
-  '((t :foreground "black" :background "black"))
+  '((t :inherit ansi-color-black))
   "Face used to render black color code."
-  :group 'term)
+  :group 'term
+  :version "28.1")
 
 (defface term-color-red
-  '((t :foreground "red3" :background "red3"))
+  '((t :inherit ansi-color-red))
   "Face used to render red color code."
-  :group 'term)
+  :group 'term
+  :version "28.1")
 
 (defface term-color-green
-  '((t :foreground "green3" :background "green3"))
+  '((t :inherit ansi-color-green))
   "Face used to render green color code."
-  :group 'term)
+  :group 'term
+  :version "28.1")
 
 (defface term-color-yellow
-  '((t :foreground "yellow3" :background "yellow3"))
+  '((t :inherit ansi-color-yellow))
   "Face used to render yellow color code."
-  :group 'term)
+  :group 'term
+  :version "28.1")
 
 (defface term-color-blue
-  '((t :foreground "blue2" :background "blue2"))
+  '((t :inherit ansi-color-blue))
   "Face used to render blue color code."
-  :group 'term)
+  :group 'term
+  :version "28.1")
 
 (defface term-color-magenta
-  '((t :foreground "magenta3" :background "magenta3"))
+  '((t :inherit ansi-color-magenta))
   "Face used to render magenta color code."
-  :group 'term)
+  :group 'term
+  :version "28.1")
 
 (defface term-color-cyan
-  '((t :foreground "cyan3" :background "cyan3"))
+  '((t :inherit ansi-color-cyan))
   "Face used to render cyan color code."
-  :group 'term)
+  :group 'term
+  :version "28.1")
 
 (defface term-color-white
-  '((t :foreground "white" :background "white"))
+  '((t :inherit ansi-color-white))
   "Face used to render white color code."
-  :group 'term)
+  :group 'term
+  :version "28.1")
+
+(defface term-color-bright-black
+  '((t :inherit ansi-color-bright-black))
+  "Face used to render bright black color code."
+  :group 'term
+  :version "28.1")
+
+(defface term-color-bright-red
+  '((t :inherit ansi-color-bright-red))
+  "Face used to render bright red color code."
+  :group 'term
+  :version "28.1")
+
+(defface term-color-bright-green
+  '((t :inherit ansi-color-bright-green))
+  "Face used to render bright green color code."
+  :group 'term
+  :version "28.1")
+
+(defface term-color-bright-yellow
+  '((t :inherit ansi-color-bright-yellow))
+  "Face used to render bright yellow color code."
+  :group 'term
+  :version "28.1")
+
+(defface term-color-bright-blue
+  '((t :inherit ansi-color-bright-blue))
+  "Face used to render bright blue color code."
+  :group 'term
+  :version "28.1")
+
+(defface term-color-bright-magenta
+  '((t :inherit ansi-color-bright-magenta))
+  "Face used to render bright magenta color code."
+  :group 'term
+  :version "28.1")
+
+(defface term-color-bright-cyan
+  '((t :inherit ansi-color-bright-cyan))
+  "Face used to render bright cyan color code."
+  :group 'term
+  :version "28.1")
+
+(defface term-color-bright-white
+  '((t :inherit ansi-color-bright-white))
+  "Face used to render bright white color code."
+  :group 'term
+  :version "28.1")
 
 (defcustom term-buffer-maximum-size 8192
   "The maximum size in lines for term buffers.
@@ -3223,6 +3289,15 @@ term-reset-terminal
   ;; FIXME: No idea why this is here, it looks wrong.  --Stef
   (setq term-ansi-face-already-done nil))
 
+(defun term--maybe-brighten-color (color bold)
+  "Possibly convert COLOR to its bright variant.
+COLOR is an index into `ansi-term-color-vector'.  If BOLD and
+`ansi-color-bold-is-bright' are non-nil and COLOR is a regular color,
+return the bright version of COLOR; otherwise, return COLOR."
+  (if (and ansi-color-bold-is-bright bold (<= 1 color 8))
+      (+ color 8)
+    color))
+
 ;; New function to deal with ansi colorized output, as you can see you can
 ;; have any bold/underline/fg/bg/reverse combination. -mm
 
@@ -3262,6 +3337,10 @@ term-handle-colors-array
    ((and (>= parameter 30) (<= parameter 37))
     (setq term-ansi-current-color (- parameter 29)))
 
+   ;; Bright foreground
+   ((and (>= parameter 90) (<= parameter 97))
+    (setq term-ansi-current-color (- parameter 81)))
+
    ;; Reset foreground
    ((eq parameter 39)
     (setq term-ansi-current-color 0))
@@ -3270,6 +3349,10 @@ term-handle-colors-array
    ((and (>= parameter 40) (<= parameter 47))
     (setq term-ansi-current-bg-color (- parameter 39)))
 
+   ;; Bright foreground
+   ((and (>= parameter 100) (<= parameter 107))
+    (setq term-ansi-current-bg-color (- parameter 91)))
+
    ;; Reset background
    ((eq parameter 49)
     (setq term-ansi-current-bg-color 0))
@@ -3288,37 +3371,43 @@ term-handle-colors-array
   ;;          term-ansi-current-bg-color)
 
   (unless term-ansi-face-already-done
-    (if term-ansi-current-invisible
-        (let ((color
-               (if term-ansi-current-reverse
-                   (face-foreground
-                    (elt ansi-term-color-vector term-ansi-current-color)
-                    nil 'default)
-                 (face-background
-                  (elt ansi-term-color-vector term-ansi-current-bg-color)
-                  nil 'default))))
-          (setq term-current-face
-                (list :background color
-                      :foreground color))
-          ) ;; No need to bother with anything else if it's invisible.
-      (setq term-current-face
-            (list :foreground
-                  (face-foreground
-                   (elt ansi-term-color-vector term-ansi-current-color)
-                   nil 'default)
-                  :background
-                  (face-background
-                   (elt ansi-term-color-vector term-ansi-current-bg-color)
-                   nil 'default)
-                  :inverse-video term-ansi-current-reverse))
-
-      (when term-ansi-current-bold
+    (let ((current-color (term--maybe-brighten-color
+                          term-ansi-current-color
+                          term-ansi-current-bold))
+          (current-bg-color (term--maybe-brighten-color
+                             term-ansi-current-bg-color
+                             term-ansi-current-bold)))
+      (if term-ansi-current-invisible
+          (let ((color
+                 (if term-ansi-current-reverse
+                     (face-foreground
+                      (elt ansi-term-color-vector current-color)
+                      nil 'default)
+                   (face-background
+                    (elt ansi-term-color-vector current-bg-color)
+                    nil 'default))))
+            (setq term-current-face
+                  (list :background color
+                        :foreground color))
+            ) ;; No need to bother with anything else if it's invisible.
         (setq term-current-face
-              `(,term-current-face :inherit term-bold)))
+              (list :foreground
+                    (face-foreground
+                     (elt ansi-term-color-vector current-color)
+                     nil 'default)
+                    :background
+                    (face-background
+                     (elt ansi-term-color-vector current-bg-color)
+                     nil 'default)
+                    :inverse-video term-ansi-current-reverse))
+
+        (when term-ansi-current-bold
+          (setq term-current-face
+                `(,term-current-face :inherit term-bold)))
 
-      (when term-ansi-current-underline
-        (setq term-current-face
-              `(,term-current-face :inherit term-underline)))))
+        (when term-ansi-current-underline
+          (setq term-current-face
+                `(,term-current-face :inherit term-underline))))))
 
   ;;	(message "Debug %S" term-current-face)
   ;; FIXME: shouldn't we set term-ansi-face-already-done to t here?  --Stef
diff --git a/test/lisp/term-tests.el b/test/lisp/term-tests.el
index 50ac370b5b..96b6d73488 100644
--- a/test/lisp/term-tests.el
+++ b/test/lisp/term-tests.el
@@ -28,6 +28,51 @@
 (defvar term-height)                    ; Number of lines in window.
 (defvar term-width)                     ; Number of columns in window.
 
+(defvar yellow-fg-props
+  `( :foreground ,(face-foreground 'term-color-yellow nil 'default)
+     :background "unspecified-bg" :inverse-video nil))
+(defvar yellow-bg-props
+  `( :foreground "unspecified-fg"
+     :background ,(face-background 'term-color-yellow nil 'default)
+     :inverse-video nil))
+(defvar bright-yellow-fg-props
+  `( :foreground ,(face-foreground 'term-color-bright-yellow nil 'default)
+     :background "unspecified-bg" :inverse-video nil))
+(defvar bright-yellow-bg-props
+  `( :foreground "unspecified-fg"
+     :background ,(face-background 'term-color-bright-yellow nil 'default)
+     :inverse-video nil))
+
+(defvar ansi-test-strings
+  `(("\e[33mHello World\e[0m"
+     ,(propertize "Hello World" 'font-lock-face yellow-fg-props))
+    ("\e[43mHello World\e[0m"
+     ,(propertize "Hello World" 'font-lock-face yellow-bg-props))
+    ("\e[93mHello World\e[0m"
+     ,(propertize "Hello World" 'font-lock-face bright-yellow-fg-props))
+    ("\e[103mHello World\e[0m"
+     ,(propertize "Hello World" 'font-lock-face bright-yellow-bg-props))
+    ("\e[1;33mHello World\e[0m"
+     ,(propertize "Hello World" 'font-lock-face
+                  `(,yellow-fg-props :inherit term-bold))
+     ,(propertize "Hello World" 'font-lock-face
+                  `(,bright-yellow-fg-props :inherit term-bold)))
+    ("\e[33;1mHello World\e[0m"
+     ,(propertize "Hello World" 'font-lock-face
+                  `(,yellow-fg-props :inherit term-bold))
+     ,(propertize "Hello World" 'font-lock-face
+                  `(,bright-yellow-fg-props :inherit term-bold)))
+    ("\e[1m\e[33mHello World\e[0m"
+     ,(propertize "Hello World" 'font-lock-face
+                  `(,yellow-fg-props :inherit term-bold))
+     ,(propertize "Hello World" 'font-lock-face
+                  `(,bright-yellow-fg-props :inherit term-bold)))
+    ("\e[33m\e[1mHello World\e[0m"
+     ,(propertize "Hello World" 'font-lock-face
+                  `(,yellow-fg-props :inherit term-bold))
+     ,(propertize "Hello World" 'font-lock-face
+                  `(,bright-yellow-fg-props :inherit term-bold)))))
+
 (defun term-test-screen-from-input (width height input &optional return-var)
   (with-temp-buffer
     (term-mode)
@@ -48,7 +93,7 @@ term-test-screen-from-input
                 (mapc (lambda (input) (term-emulate-terminal proc input)) input)
               (term-emulate-terminal proc input))
       (if return-var (buffer-local-value return-var (current-buffer))
-        (buffer-substring-no-properties (point-min) (point-max))))))
+        (buffer-substring (point-min) (point-max))))))
 
 (ert-deftest term-simple-lines ()
   (skip-unless (not (memq system-type '(windows-nt ms-dos))))
@@ -77,6 +122,24 @@ term-line-wrap
            (term-test-screen-from-input 40 12 (let ((str (make-string 30 ?a)))
                                                 (list str str))))))
 
+(ert-deftest term-colors ()
+  (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+  (pcase-dolist (`(,str ,expected) ansi-test-strings)
+    (let ((result (term-test-screen-from-input 40 12 str)))
+      (should (equal result expected))
+      (should (equal (text-properties-at 0 result)
+                     (text-properties-at 0 expected))))))
+
+(ert-deftest term-colors-bold-is-bright ()
+  (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+  (let ((ansi-color-bold-is-bright t))
+    (pcase-dolist (`(,str ,expected ,bright-expected) ansi-test-strings)
+      (let ((expected (or bright-expected expected))
+            (result (term-test-screen-from-input 40 12 str)))
+        (should (equal result expected))
+        (should (equal (text-properties-at 0 result)
+                       (text-properties-at 0 expected)))))))
+
 (ert-deftest term-cursor-movement ()
   (skip-unless (not (memq system-type '(windows-nt ms-dos))))
   ;; Absolute positioning.
-- 
2.25.1


  reply	other threads:[~2021-09-23  1:47 UTC|newest]

Thread overview: 20+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-08-24  4:02 bug#50179: [PATCH] Add support for "bright" ANSI colors to ansi-color and term-mode Jim Porter
2021-08-24 12:07 ` Eli Zaretskii
2021-08-24 17:38   ` Jim Porter
2021-08-24 17:59     ` Eli Zaretskii
2021-08-24 18:59       ` Jim Porter
2021-08-24 22:53         ` Jim Porter
2021-08-25 12:04           ` Lars Ingebrigtsen
2021-08-25 16:41             ` Jim Porter
2021-08-25 16:46               ` Lars Ingebrigtsen
2021-08-25 16:54                 ` Eli Zaretskii
2021-08-26 13:23                   ` Lars Ingebrigtsen
2021-09-18 18:58                     ` bug#50179: [UPDATED PATCH] " Jim Porter
2021-09-19 14:45                       ` Lars Ingebrigtsen
2021-09-22 19:39                         ` bug#50179: [WIP PATCH v3] " Jim Porter
2021-09-22 19:49                           ` Lars Ingebrigtsen
2021-09-23  1:47                             ` Jim Porter [this message]
2021-09-23 20:58                               ` bug#50179: [PATCH v4] " Lars Ingebrigtsen
2021-09-23 21:21                                 ` Jim Porter
2021-08-25  7:06       ` bug#50179: [PATCH] " Kévin Le Gouguec
2021-08-25 11:57         ` Eli Zaretskii

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=24dfacb5-067d-580d-2608-8198d9e4f1a3@gmail.com \
    --to=jporterbugs@gmail.com \
    --cc=50179@debbugs.gnu.org \
    --cc=larsi@gnus.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).