* bug#50806: 27.2; [PATCH] Optimize ansi-color.el
@ 2021-09-25 22:32 miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-03 16:31 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-03 17:53 ` Jim Porter
0 siblings, 2 replies; 12+ messages in thread
From: miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-09-25 22:32 UTC (permalink / raw)
To: 50806; +Cc: Jim Porter
[-- Attachment #1.1: Type: text/plain, Size: 696 bytes --]
Attached patch speeds up ansi-color. It tries to eliminate as many
allocations (cons and list) as possible.
Benchmarks, recorded in emacs -q, are in the second attachments. With
the patch applied, there is a 26% speedup in elapsed time, mostly
because the garbage collector has to take care of less allocations.
Two less important side notes:
1) This patch additionally makes it very straight forward to add support
for ANSI color codes 38 and 48 allowing 256-colors and 24bit
full-color. I plan to submit such a patch later (for both ansi-color
and term-mode).
2) Two vector variables, that were recently added by Jim, were merged
into one. Adding him as CC.
Best regards.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-Optimize-ansi-color.el.patch --]
[-- Type: text/x-patch, Size: 19801 bytes --]
From 9b40c13dd83a1c9336ba2eadf90041c07acb82a1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Sat, 25 Sep 2021 23:05:11 +0200
Subject: [PATCH 1/3] Optimize ansi-color.el
* lisp/ansi-color.el (ansi-color-normal-colors-vector):
(ansi-color-bright-colors-vector): Merge these two vectors into one.
(ansi-color-context-region):
(ansi-color-context): Adjust doc string to the new format of
ansi-color context.
(ansi-color--find-face): Rename to ansi-color--face-vec-face
(ansi-color--face-vec-face): Adjust to the new format ansi-color
context.
(ansi-color-apply):
(ansi-color-apply-on-region): Adjust to the new format of ansi-color
context in order to speed these two functions up
(ansi-color-apply-sequence): Make it obsolete
(ansi-color--update-face-vec): New function to handle the new format
of ansi-color context.
(ansi-color-get-face-1): Make obsolete as this function isn't used any
more.
---
lisp/ansi-color.el | 308 ++++++++++++++++++++++++++++++---------------
1 file changed, 206 insertions(+), 102 deletions(-)
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index b1c9cdaeca..d9d6f1c78d 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -288,7 +288,7 @@ ansi-color-basic-faces-vector
6 rapidly blinking
7 negative image")
-(defvar ansi-color-normal-colors-vector
+(defvar ansi-color-colors-vector
[ansi-color-black
ansi-color-red
ansi-color-green
@@ -296,12 +296,26 @@ ansi-color-normal-colors-vector
ansi-color-blue
ansi-color-magenta
ansi-color-cyan
- ansi-color-white]
+ ansi-color-white
+
+ 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 color.
-This vector holds the faces used for SGR control sequence parameters
-30 to 37 (foreground colors) and 40 to 47 (background colors).
+The first eight elements are faces used for SGR control sequence
+parameters 30 to 37 (foreground colors) and 40 to 47 (background
+colors). The second eight elements are the faces used for SGR
+control sequence parameters 90 to 97 (bright foreground colors)
+and 100 to 107 (bright background colors).
Parameter Color
+
30 40 black
31 41 red
32 42 green
@@ -309,23 +323,8 @@ ansi-color-normal-colors-vector
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).
+ 37 47 white
-Parameter Color
90 100 bright black
91 101 bright red
92 102 bright green
@@ -458,11 +457,18 @@ 'ansi-color-unfontify-region
;; Working with strings
(defvar-local ansi-color-context nil
"Context saved between two calls to `ansi-color-apply'.
-This is a list of the form (CODES FRAGMENT) or nil. CODES
+This is a list of the form (FACE-VEC FRAGMENT) or nil. FACE-VEC
represents the state the last call to `ansi-color-apply' ended
-with, currently a list of ansi codes, and FRAGMENT is a string
-starting with an escape sequence, possibly the start of a new
-escape sequence.")
+with, currently a list of the form
+
+(BASIC-FACES FG BG).
+
+BASIC-FACES is a bool-vector that specifies which basic faces
+from `ansi-color-basic-faces-vector' to apply. FG and BG are
+ANSI color codes for the foreground and background color.
+
+FRAGMENT is a string starting with an escape sequence, possibly
+the start of a new escape sequence.")
(defun ansi-color-filter-apply (string)
"Filter out all ANSI control sequences from STRING.
@@ -494,20 +500,39 @@ ansi-color-filter-apply
(setq ansi-color-context (if fragment (list nil fragment))))
(apply #'concat (nreverse result))))
-(defun ansi-color--find-face (codes)
- "Return the face corresponding to CODES."
- ;; 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
- (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)))
+(defun ansi-color--face-vec-face (face-vec)
+ "Return the face corresponding to FACE-VEC.
+FACE-VEC is a list containing information about the ANSI sequence
+code. It is usually stored as the car of the variable
+`ansi-color-context-region'."
+ (let* ((basic-faces (car face-vec))
+ (colors (cdr face-vec))
+ (bright (and ansi-color-bold-is-bright (aref basic-faces 1)))
+ (faces nil))
+
+ (when-let ((fg (car colors)))
+ (push
+ `(:foreground
+ ,(face-foreground
+ (aref ansi-color-colors-vector (logior (if bright 8 0) fg))
+ nil 'default))
+ faces))
+ (when-let ((bg (cadr colors)))
+ (push
+ `(:background
+ ,(face-background
+ (aref ansi-color-colors-vector (logior (if bright 8 0) bg))
+ nil 'default))
+ faces))
+
+ (let ((i 8))
+ (while (> i 0)
+ (setq i (1- i))
+ (when (aref basic-faces i)
+ (push (aref ansi-color-basic-faces-vector i) faces))))
;; Avoid some long-lived conses in the common case.
(if (cdr faces)
- (nreverse faces)
+ faces
(car faces))))
(defun ansi-color-apply (string)
@@ -524,49 +549,71 @@ ansi-color-apply
Set `ansi-color-context' to nil if you don't want this.
This function can be added to `comint-preoutput-filter-functions'."
- (let ((codes (car ansi-color-context))
- (start 0) end result)
+ (let* ((context
+ (or ansi-color-context
+ (setq ansi-color-context
+ (list
+ (list
+ ;; 8 slots for the basic faces
+ (make-bool-vector 8 nil)
+ ;; 2 slots for fg and bg number
+ nil nil)
+ ""))))
+ (face-vec (car context))
+ (start 0)
+ end result)
;; If context was saved and is a string, prepend it.
- (if (cadr ansi-color-context)
- (setq string (concat (cadr ansi-color-context) string)
- ansi-color-context nil))
+ (setq string (concat (cadr context) string))
+ (setcar (cdr context) "")
;; Find the next escape sequence.
(while (setq end (string-match ansi-color-control-seq-regexp string start))
(let ((esc-end (match-end 0)))
;; Colorize the old block from start to end using old face.
- (when codes
+ (when-let ((face (ansi-color--face-vec-face face-vec)))
(put-text-property start end 'font-lock-face
- (ansi-color--find-face codes) string))
+ face string))
(push (substring string start end) result)
(setq start (match-end 0))
;; If this is a color escape sequence,
(when (eq (aref string (1- esc-end)) ?m)
;; create a new face from it.
- (setq codes (ansi-color-apply-sequence
- (substring string end esc-end) codes)))))
+ (let ((cur-pos end))
+ (ansi-color--update-face-vec
+ face-vec
+ (lambda ()
+ (when (string-match ansi-color-parameter-regexp
+ string cur-pos)
+ (setq cur-pos (match-end 0))
+ (when (<= cur-pos esc-end)
+ (string-to-number (match-string 1 string))))))))))
;; if the rest of the string should have a face, put it there
- (when codes
+ (when-let ((face (ansi-color--face-vec-face face-vec)))
(put-text-property start (length string)
- 'font-lock-face (ansi-color--find-face codes) string))
+ 'font-lock-face face string))
;; save context, add the remainder of the string to the result
- (let (fragment)
- (if (string-match "\033" string start)
- (let ((pos (match-beginning 0)))
- (setq fragment (substring string pos))
- (push (substring string start pos) result))
- (push (substring string start) result))
- (setq ansi-color-context (if (or codes fragment) (list codes fragment))))
+ (if (string-match "\033" string start)
+ (let ((pos (match-beginning 0)))
+ (setcar (cdr context) (substring string pos))
+ (push (substring string start pos) result))
+ (push (substring string start) result))
(apply 'concat (nreverse result))))
;; Working with regions
(defvar-local ansi-color-context-region nil
"Context saved between two calls to `ansi-color-apply-on-region'.
-This is a list of the form (CODES MARKER) or nil. CODES
+This is a list of the form (FACE-VEC MARKER) or nil. FACE-VEC
represents the state the last call to `ansi-color-apply-on-region'
-ended with, currently a list of ansi codes, and MARKER is a
-buffer position within an escape sequence or the last position
-processed.")
+ended with, currently a list of the form
+
+(BASIC-FACES FG BG).
+
+BASIC-FACES is a bool-vector that specifies which basic faces
+from `ansi-color-basic-faces-vector' to apply. FG and BG are
+ANSI color codes for the foreground and background color.
+
+MARKER is a buffer position within an escape sequence or the last
+position processed.")
(defun ansi-color-filter-region (begin end)
"Filter out all ANSI control sequences from region BEGIN to END.
@@ -608,58 +655,63 @@ ansi-color-apply-on-region
If PRESERVE-SEQUENCES is t, the sequences are hidden instead of
being deleted."
- (let ((codes (car ansi-color-context-region))
- (start-marker (or (cadr ansi-color-context-region)
- (copy-marker begin)))
- (end-marker (copy-marker end)))
+ (let* ((context
+ (or ansi-color-context-region
+ (setq ansi-color-context-region
+ (list
+ (list
+ ;; 8 slots for the basic faces
+ (make-bool-vector 8 nil)
+ ;; 2 slots for fg and bg numbers
+ nil nil)
+ (copy-marker begin)))))
+ (face-vec (car context))
+ (start-marker (cadr context))
+ (end-marker (copy-marker end)))
(save-excursion
(goto-char start-marker)
;; Find the next escape sequence.
(while (re-search-forward ansi-color-control-seq-regexp end-marker t)
;; Extract escape sequence.
- (let ((esc-seq (buffer-substring
- (match-beginning 0) (point))))
- (if preserve-sequences
- ;; Make the escape sequence transparent.
- (overlay-put (make-overlay (match-beginning 0) (point))
- 'invisible t)
- ;; Otherwise, strip.
- (delete-region (match-beginning 0) (point)))
-
+ (let ((esc-beg (match-beginning 0))
+ (esc-end (point)))
;; Colorize the old block from start to end using old face.
(funcall ansi-color-apply-face-function
(prog1 (marker-position start-marker)
;; Store new start position.
- (set-marker start-marker (point)))
- (match-beginning 0) (ansi-color--find-face codes))
+ (set-marker start-marker esc-end))
+ esc-beg (ansi-color--face-vec-face face-vec))
;; If this is a color sequence,
- (when (eq (aref esc-seq (1- (length esc-seq))) ?m)
- ;; update the list of ansi codes.
- (setq codes (ansi-color-apply-sequence esc-seq codes)))))
+ (when (eq (char-before esc-end) ?m)
+ (goto-char esc-beg)
+ (ansi-color--update-face-vec
+ face-vec (lambda ()
+ (when (re-search-forward ansi-color-parameter-regexp
+ esc-end t)
+ (string-to-number (match-string 1))))))
+
+ (if preserve-sequences
+ ;; Make the escape sequence transparent.
+ (overlay-put (make-overlay esc-beg esc-end) 'invisible t)
+ ;; Otherwise, strip.
+ (delete-region esc-beg esc-end))))
;; search for the possible start of a new escape sequence
(if (re-search-forward "\033" end-marker t)
- (progn
- ;; if the rest of the region should have a face, put it there
- (funcall ansi-color-apply-face-function
- start-marker (point) (ansi-color--find-face codes))
- ;; save codes and point
- (setq ansi-color-context-region
- (list codes (copy-marker (match-beginning 0)))))
- ;; if the rest of the region should have a face, put it there
- (funcall ansi-color-apply-face-function
- start-marker end-marker (ansi-color--find-face codes))
- ;; Save a restart position when there are codes active. It's
- ;; convenient for man.el's process filter to pass `begin'
- ;; positions that overlap regions previously colored; these
- ;; `codes' should not be applied to that overlap, so we need
- ;; to know where they should really start.
- (setq ansi-color-context-region
- (if codes (list codes (copy-marker (point)))))))
- ;; Clean up our temporary markers.
- (unless (eq start-marker (cadr ansi-color-context-region))
- (set-marker start-marker nil))
- (unless (eq end-marker (cadr ansi-color-context-region))
- (set-marker end-marker nil))))
+ (progn
+ (while (re-search-forward "\033" end-marker t))
+ (backward-char))
+ (goto-char end-marker))
+ (funcall ansi-color-apply-face-function
+ start-marker (point)
+ (ansi-color--face-vec-face face-vec))
+ ;; Save a restart position when there are codes active. It's
+ ;; convenient for man.el's process filter to pass `begin'
+ ;; positions that overlap regions previously colored; these
+ ;; `codes' should not be applied to that overlap, so we need
+ ;; to know where they should really start.
+ (set-marker start-marker (point)))
+ ;; Clean up our temporary marker.
+ (set-marker end-marker nil)))
(defun ansi-color-apply-overlay-face (beg end face)
"Make an overlay from BEG to END, and apply face FACE.
@@ -767,6 +819,7 @@ ansi-color-apply-sequence
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."
+ (declare (obsolete "it isn't used any more." "28.1"))
(let ((new-codes (ansi-color-parse-sequence escape-sequence)))
(while new-codes
(let* ((new (pop new-codes))
@@ -795,6 +848,56 @@ ansi-color-apply-sequence
(_ nil)))))
codes))
+(defun ansi-color--update-face-vec (face-vec iterator)
+ "Apply escape sequences to FACE-VEC.
+
+Destructively modify FACE-VEC, which should be a list containing
+face information. It is described in
+`ansi-color-context-region'. ITERATOR is a function which is
+called repeatedly with zero arguments and should return either
+the next ANSI code in the current sequence as a number or nil if
+there are no more ANSI codes left
+
+For each new code, the following happens: if it is 1-7, set the
+corresponding properties; if it is 21-25 or 27, unset appropriate
+properties; if it is 30-37 (or 90-97) or resp. 39, set the
+foreground color or resp. unset it; if it is 40-47 (or 100-107)
+resp. 49, set the background color or resp. unset it; if it is 38
+or 48, the following codes are used to set the foreground or
+background color and the correct color mode; any other code will
+unset all properties and colors."
+ (let ((basic-faces (car face-vec))
+ (colors (cdr face-vec))
+ new q do-clear)
+ (while (setq new (funcall iterator))
+ (setq q (/ new 10))
+ (pcase q
+ (0 (if (memq new '(0 8 9))
+ (setq do-clear t)
+ (aset basic-faces new t)))
+ (2 (if (memq new '(20 26 28 29))
+ (setq do-clear t)
+ ;; The standard says `21 doubly underlined' while
+ ;; https://en.wikipedia.org/wiki/ANSI_escape_code claims
+ ;; `21 Bright/Bold: off or Underline: Double'.
+ (aset basic-faces (- new 20) nil)
+ (aset basic-faces (pcase new (22 1) (25 6) (_ 0)) nil)))
+ ((or 3 4 9 10)
+ (let ((r (mod new 10))
+ (cell (if (memq q '(3 9)) colors (cdr colors))))
+ (pcase r
+ (8 (setq do-clear t))
+ (9 (setcar cell nil))
+ (_ (setcar cell (+ (if (memq q '(3 4)) 0 8) r))))))
+ (_ (setq do-clear t)))
+
+ (when do-clear
+ (setq do-clear nil)
+ ;; Zero out our bool vector without any allocation
+ (bool-vector-intersection basic-faces #&8"\0" basic-faces)
+ (setcar colors nil)
+ (setcar (cdr colors) nil)))))
+
(defun ansi-color-make-color-map ()
"Create a vector of face definitions and return it.
@@ -859,6 +962,7 @@ ansi-color-get-face-1
"Get face definition for ANSI-CODE.
BRIGHT, if non-nil, requests \"bright\" ANSI colors, even if ANSI-CODE
is a normal-intensity color."
+ (declare (obsolete "it isn't used any more." "28.1"))
(when (and bright (<= 30 ansi-code 49))
(setq ansi-code (+ ansi-code 60)))
(cond ((<= 0 ansi-code 7)
@@ -866,22 +970,22 @@ ansi-color-get-face-1
((<= 30 ansi-code 38)
(list :foreground
(face-foreground
- (aref ansi-color-normal-colors-vector (- ansi-code 30))
+ (aref ansi-color-colors-vector (- ansi-code 30))
nil 'default)))
((<= 40 ansi-code 48)
(list :background
(face-background
- (aref ansi-color-normal-colors-vector (- ansi-code 40))
+ (aref ansi-color-colors-vector (- ansi-code 40))
nil 'default)))
((<= 90 ansi-code 98)
(list :foreground
(face-foreground
- (aref ansi-color-bright-colors-vector (- ansi-code 90))
+ (aref ansi-color-colors-vector (+ 8 (- ansi-code 90)))
nil 'default)))
((<= 100 ansi-code 108)
(list :background
(face-background
- (aref ansi-color-bright-colors-vector (- ansi-code 100))
+ (aref ansi-color-colors-vector (+ 8 (- ansi-code 100)))
nil 'default)))))
(provide 'ansi-color)
--
2.33.0
[-- Attachment #1.3: ansi-color-benchmark.org --]
[-- Type: application/vnd.lotus-organizer, Size: 1995 bytes --]
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]
^ permalink raw reply related [flat|nested] 12+ messages in thread
* bug#50806: 27.2; [PATCH] Optimize ansi-color.el
2021-09-25 22:32 bug#50806: 27.2; [PATCH] Optimize ansi-color.el miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-10-03 16:31 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-03 17:53 ` Jim Porter
1 sibling, 0 replies; 12+ messages in thread
From: miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-10-03 16:31 UTC (permalink / raw)
To: 50806; +Cc: Jim Porter
[-- Attachment #1.1: Type: text/plain, Size: 264 bytes --]
miha--- via "Bug reports for GNU Emacs, the Swiss army knife of text
editors" <bug-gnu-emacs@gnu.org> writes:
> Attached patch speeds up ansi-color. It tries to eliminate as many
> allocations (cons and list) as possible.
>
Sending patch, adjusted for Emacs 29.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-Optimize-ansi-color.el.patch --]
[-- Type: text/x-patch, Size: 20021 bytes --]
From 51ea3f59898fec91a9760447c9c5f4bbd51f85f2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Sat, 2 Oct 2021 21:36:10 +0200
Subject: [PATCH] Optimize ansi-color.el
(ansi-color-context-region):
(ansi-color-context): Adjust doc string to the new format of
ansi-color context.
(ansi-color--find-face): Rename to ansi-color--face-vec-face
(ansi-color--face-vec-face): Adjust to the new format ansi-color
context.
(ansi-color-filter-apply):
(ansi-color-apply):
(ansi-color-filter-region):
(ansi-color-apply-on-region): Adjust to the new format of ansi-color
context in order to speed these functions up.
(ansi-color-apply-sequence): Make it obsolete.
(ansi-color--update-face-vec): New function to handle the new format
of ansi-color context.
(ansi-color-get-face-1): Make obsolete as this function isn't used any
more.
---
lisp/ansi-color.el | 309 +++++++++++++++++++++++++++++++--------------
1 file changed, 217 insertions(+), 92 deletions(-)
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index b1c9cdaeca..7b46754d83 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -458,11 +458,18 @@ 'ansi-color-unfontify-region
;; Working with strings
(defvar-local ansi-color-context nil
"Context saved between two calls to `ansi-color-apply'.
-This is a list of the form (CODES FRAGMENT) or nil. CODES
+This is a list of the form (FACE-VEC FRAGMENT) or nil. FACE-VEC
represents the state the last call to `ansi-color-apply' ended
-with, currently a list of ansi codes, and FRAGMENT is a string
-starting with an escape sequence, possibly the start of a new
-escape sequence.")
+with, currently a list of the form
+
+(BASIC-FACES FG BG).
+
+BASIC-FACES is a bool-vector that specifies which basic faces
+from `ansi-color-basic-faces-vector' to apply. FG and BG are
+ANSI color codes for the foreground and background color.
+
+FRAGMENT is a string starting with an escape sequence, possibly
+the start of a new escape sequence.")
(defun ansi-color-filter-apply (string)
"Filter out all ANSI control sequences from STRING.
@@ -473,17 +480,17 @@ ansi-color-filter-apply
`ansi-color-context' to nil if you don't want this.
This function can be added to `comint-preoutput-filter-functions'."
- (let ((start 0) end result)
+ (let ((context (ansi-color--ensure-context 'ansi-color-context nil))
+ (start 0) end result)
;; if context was saved and is a string, prepend it
- (if (cadr ansi-color-context)
- (setq string (concat (cadr ansi-color-context) string)
- ansi-color-context nil))
+ (setq string (concat (cadr context) string))
+ (setcar (cdr context) "")
;; find the next escape sequence
(while (setq end (string-match ansi-color-control-seq-regexp string start))
(push (substring string start end) result)
(setq start (match-end 0)))
;; save context, add the remainder of the string to the result
- (let (fragment)
+ (let ((fragment ""))
(push (substring string start
(if (string-match "\033" string start)
(let ((pos (match-beginning 0)))
@@ -491,25 +498,9 @@ ansi-color-filter-apply
pos)
nil))
result)
- (setq ansi-color-context (if fragment (list nil fragment))))
+ (setcar (cdr context) fragment))
(apply #'concat (nreverse result))))
-(defun ansi-color--find-face (codes)
- "Return the face corresponding to CODES."
- ;; 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
- (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)
- (car faces))))
-
(defun ansi-color-apply (string)
"Translates SGR control sequences into text properties.
Delete all other control sequences without processing them.
@@ -524,49 +515,129 @@ ansi-color-apply
Set `ansi-color-context' to nil if you don't want this.
This function can be added to `comint-preoutput-filter-functions'."
- (let ((codes (car ansi-color-context))
- (start 0) end result)
+ (let* ((context
+ (ansi-color--ensure-context 'ansi-color-context nil))
+ (face-vec (car context))
+ (start 0)
+ end result)
;; If context was saved and is a string, prepend it.
- (if (cadr ansi-color-context)
- (setq string (concat (cadr ansi-color-context) string)
- ansi-color-context nil))
+ (setq string (concat (cadr context) string))
+ (setcar (cdr context) "")
;; Find the next escape sequence.
(while (setq end (string-match ansi-color-control-seq-regexp string start))
(let ((esc-end (match-end 0)))
;; Colorize the old block from start to end using old face.
- (when codes
+ (when-let ((face (ansi-color--face-vec-face face-vec)))
(put-text-property start end 'font-lock-face
- (ansi-color--find-face codes) string))
+ face string))
(push (substring string start end) result)
(setq start (match-end 0))
;; If this is a color escape sequence,
(when (eq (aref string (1- esc-end)) ?m)
;; create a new face from it.
- (setq codes (ansi-color-apply-sequence
- (substring string end esc-end) codes)))))
+ (let ((cur-pos end))
+ (ansi-color--update-face-vec
+ face-vec
+ (lambda ()
+ (when (string-match ansi-color-parameter-regexp
+ string cur-pos)
+ (setq cur-pos (match-end 0))
+ (when (<= cur-pos esc-end)
+ (string-to-number (match-string 1 string))))))))))
;; if the rest of the string should have a face, put it there
- (when codes
+ (when-let ((face (ansi-color--face-vec-face face-vec)))
(put-text-property start (length string)
- 'font-lock-face (ansi-color--find-face codes) string))
+ 'font-lock-face face string))
;; save context, add the remainder of the string to the result
- (let (fragment)
- (if (string-match "\033" string start)
- (let ((pos (match-beginning 0)))
- (setq fragment (substring string pos))
- (push (substring string start pos) result))
- (push (substring string start) result))
- (setq ansi-color-context (if (or codes fragment) (list codes fragment))))
+ (if (string-match "\033" string start)
+ (let ((pos (match-beginning 0)))
+ (setcar (cdr context) (substring string pos))
+ (push (substring string start pos) result))
+ (push (substring string start) result))
(apply 'concat (nreverse result))))
+(defun ansi-color--ensure-context (context-sym position)
+ "Return CONTEXT-SYM's value as a valid context.
+If it is nil, set CONTEXT-SYM's value to a new context and return
+it. Context is a list of the form as described in
+`ansi-color-context' if POSITION is nil, or
+`ansi-color-context-region' if POSITION is non-nil.
+
+If CONTEXT-SYM's value is already non-nil, return it. If its
+marker doesn't point anywhere yet, position it before character
+number POSITION, if non-nil."
+ (let ((context (symbol-value context-sym)))
+ (if context
+ (if position
+ (let ((marker (cadr context)))
+ (unless (marker-position marker)
+ (set-marker marker position))
+ context)
+ context)
+ (set context-sym
+ (list (list (make-bool-vector 8 nil)
+ nil nil)
+ (if position
+ (copy-marker position)
+ ""))))))
+
+(defun ansi-color--face-vec-face (face-vec)
+ "Return the face corresponding to FACE-VEC.
+FACE-VEC is a list containing information about the ANSI sequence
+code. It is usually stored as the car of the variable
+`ansi-color-context-region'."
+ (let* ((basic-faces (car face-vec))
+ (colors (cdr face-vec))
+ (bright (and ansi-color-bold-is-bright (aref basic-faces 1)))
+ (faces nil))
+
+ (when-let ((fg (car colors)))
+ (push
+ `(:foreground
+ ,(face-foreground
+ (aref (if (or bright (>= fg 8))
+ ansi-color-bright-colors-vector
+ ansi-color-normal-colors-vector)
+ (mod fg 8))
+ nil 'default))
+ faces))
+ (when-let ((bg (cadr colors)))
+ (push
+ `(:background
+ ,(face-background
+ (aref (if (or bright (>= bg 8))
+ ansi-color-bright-colors-vector
+ ansi-color-normal-colors-vector)
+ (mod bg 8))
+ nil 'default))
+ faces))
+
+ (let ((i 8))
+ (while (> i 0)
+ (setq i (1- i))
+ (when (aref basic-faces i)
+ (push (aref ansi-color-basic-faces-vector i) faces))))
+ ;; Avoid some long-lived conses in the common case.
+ (if (cdr faces)
+ faces
+ (car faces))))
+
;; Working with regions
(defvar-local ansi-color-context-region nil
"Context saved between two calls to `ansi-color-apply-on-region'.
-This is a list of the form (CODES MARKER) or nil. CODES
+This is a list of the form (FACE-VEC MARKER) or nil. FACE-VEC
represents the state the last call to `ansi-color-apply-on-region'
-ended with, currently a list of ansi codes, and MARKER is a
-buffer position within an escape sequence or the last position
-processed.")
+ended with, currently a list of the form
+
+(BASIC-FACES FG BG).
+
+BASIC-FACES is a bool-vector that specifies which basic faces
+from `ansi-color-basic-faces-vector' to apply. FG and BG are
+ANSI color codes for the foreground and background color.
+
+MARKER is a buffer position within an escape sequence or the last
+position processed.")
(defun ansi-color-filter-region (begin end)
"Filter out all ANSI control sequences from region BEGIN to END.
@@ -576,8 +647,10 @@ ansi-color-filter-region
used for the next call to `ansi-color-apply-on-region'. Specifically,
it will override BEGIN, the start of the region. Set
`ansi-color-context-region' to nil if you don't want this."
- (let ((end-marker (copy-marker end))
- (start (or (cadr ansi-color-context-region) begin)))
+ (let* ((end-marker (copy-marker end))
+ (context (ansi-color--ensure-context
+ 'ansi-color-context-region begin))
+ (start (cadr context)))
(save-excursion
(goto-char start)
;; Delete escape sequences.
@@ -585,8 +658,8 @@ ansi-color-filter-region
(delete-region (match-beginning 0) (match-end 0)))
;; save context, add the remainder of the string to the result
(if (re-search-forward "\033" end-marker t)
- (setq ansi-color-context-region (list nil (match-beginning 0)))
- (setq ansi-color-context-region nil)))))
+ (set-marker start (match-beginning 0))
+ (set-marker start nil)))))
(defun ansi-color-apply-on-region (begin end &optional preserve-sequences)
"Translates SGR control sequences into overlays or extents.
@@ -608,58 +681,58 @@ ansi-color-apply-on-region
If PRESERVE-SEQUENCES is t, the sequences are hidden instead of
being deleted."
- (let ((codes (car ansi-color-context-region))
- (start-marker (or (cadr ansi-color-context-region)
- (copy-marker begin)))
- (end-marker (copy-marker end)))
+ (let* ((context (ansi-color--ensure-context
+ 'ansi-color-context-region begin))
+ (face-vec (car context))
+ (start-marker (cadr context))
+ (end-marker (copy-marker end)))
(save-excursion
(goto-char start-marker)
;; Find the next escape sequence.
(while (re-search-forward ansi-color-control-seq-regexp end-marker t)
;; Extract escape sequence.
- (let ((esc-seq (buffer-substring
- (match-beginning 0) (point))))
- (if preserve-sequences
- ;; Make the escape sequence transparent.
- (overlay-put (make-overlay (match-beginning 0) (point))
- 'invisible t)
- ;; Otherwise, strip.
- (delete-region (match-beginning 0) (point)))
-
+ (let ((esc-beg (match-beginning 0))
+ (esc-end (point)))
;; Colorize the old block from start to end using old face.
(funcall ansi-color-apply-face-function
(prog1 (marker-position start-marker)
;; Store new start position.
- (set-marker start-marker (point)))
- (match-beginning 0) (ansi-color--find-face codes))
+ (set-marker start-marker esc-end))
+ esc-beg (ansi-color--face-vec-face face-vec))
;; If this is a color sequence,
- (when (eq (aref esc-seq (1- (length esc-seq))) ?m)
- ;; update the list of ansi codes.
- (setq codes (ansi-color-apply-sequence esc-seq codes)))))
+ (when (eq (char-before esc-end) ?m)
+ (goto-char esc-beg)
+ (ansi-color--update-face-vec
+ face-vec (lambda ()
+ (when (re-search-forward ansi-color-parameter-regexp
+ esc-end t)
+ (string-to-number (match-string 1))))))
+
+ (if preserve-sequences
+ ;; Make the escape sequence transparent.
+ (overlay-put (make-overlay esc-beg esc-end) 'invisible t)
+ ;; Otherwise, strip.
+ (delete-region esc-beg esc-end))))
;; search for the possible start of a new escape sequence
(if (re-search-forward "\033" end-marker t)
- (progn
- ;; if the rest of the region should have a face, put it there
- (funcall ansi-color-apply-face-function
- start-marker (point) (ansi-color--find-face codes))
- ;; save codes and point
- (setq ansi-color-context-region
- (list codes (copy-marker (match-beginning 0)))))
- ;; if the rest of the region should have a face, put it there
- (funcall ansi-color-apply-face-function
- start-marker end-marker (ansi-color--find-face codes))
- ;; Save a restart position when there are codes active. It's
- ;; convenient for man.el's process filter to pass `begin'
- ;; positions that overlap regions previously colored; these
- ;; `codes' should not be applied to that overlap, so we need
- ;; to know where they should really start.
- (setq ansi-color-context-region
- (if codes (list codes (copy-marker (point)))))))
- ;; Clean up our temporary markers.
- (unless (eq start-marker (cadr ansi-color-context-region))
- (set-marker start-marker nil))
- (unless (eq end-marker (cadr ansi-color-context-region))
- (set-marker end-marker nil))))
+ (progn
+ (while (re-search-forward "\033" end-marker t))
+ (backward-char)
+ (funcall ansi-color-apply-face-function
+ start-marker (point)
+ (ansi-color--face-vec-face face-vec))
+ (set-marker start-marker (point)))
+ (let ((faces (ansi-color--face-vec-face face-vec)))
+ (funcall ansi-color-apply-face-function
+ start-marker end-marker faces)
+ ;; Save a restart position when there are codes active. It's
+ ;; convenient for man.el's process filter to pass `begin'
+ ;; positions that overlap regions previously colored; these
+ ;; `codes' should not be applied to that overlap, so we need
+ ;; to know where they should really start.
+ (set-marker start-marker (when faces end-marker)))))
+ ;; Clean up our temporary marker.
+ (set-marker end-marker nil)))
(defun ansi-color-apply-overlay-face (beg end face)
"Make an overlay from BEG to END, and apply face FACE.
@@ -767,6 +840,7 @@ ansi-color-apply-sequence
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."
+ (declare (obsolete ansi-color--update-face-vec "29.1"))
(let ((new-codes (ansi-color-parse-sequence escape-sequence)))
(while new-codes
(let* ((new (pop new-codes))
@@ -795,6 +869,56 @@ ansi-color-apply-sequence
(_ nil)))))
codes))
+(defun ansi-color--update-face-vec (face-vec iterator)
+ "Apply escape sequences to FACE-VEC.
+
+Destructively modify FACE-VEC, which should be a list containing
+face information. It is described in
+`ansi-color-context-region'. ITERATOR is a function which is
+called repeatedly with zero arguments and should return either
+the next ANSI code in the current sequence as a number or nil if
+there are no more ANSI codes left
+
+For each new code, the following happens: if it is 1-7, set the
+corresponding properties; if it is 21-25 or 27, unset appropriate
+properties; if it is 30-37 (or 90-97) or resp. 39, set the
+foreground color or resp. unset it; if it is 40-47 (or 100-107)
+resp. 49, set the background color or resp. unset it; if it is 38
+or 48, the following codes are used to set the foreground or
+background color and the correct color mode; any other code will
+unset all properties and colors."
+ (let ((basic-faces (car face-vec))
+ (colors (cdr face-vec))
+ new q do-clear)
+ (while (setq new (funcall iterator))
+ (setq q (/ new 10))
+ (pcase q
+ (0 (if (memq new '(0 8 9))
+ (setq do-clear t)
+ (aset basic-faces new t)))
+ (2 (if (memq new '(20 26 28 29))
+ (setq do-clear t)
+ ;; The standard says `21 doubly underlined' while
+ ;; https://en.wikipedia.org/wiki/ANSI_escape_code claims
+ ;; `21 Bright/Bold: off or Underline: Double'.
+ (aset basic-faces (- new 20) nil)
+ (aset basic-faces (pcase new (22 1) (25 6) (_ 0)) nil)))
+ ((or 3 4 9 10)
+ (let ((r (mod new 10))
+ (cell (if (memq q '(3 9)) colors (cdr colors))))
+ (pcase r
+ (8 (setq do-clear t))
+ (9 (setcar cell nil))
+ (_ (setcar cell (+ (if (memq q '(3 4)) 0 8) r))))))
+ (_ (setq do-clear t)))
+
+ (when do-clear
+ (setq do-clear nil)
+ ;; Zero out our bool vector without any allocation
+ (bool-vector-intersection basic-faces #&8"\0" basic-faces)
+ (setcar colors nil)
+ (setcar (cdr colors) nil)))))
+
(defun ansi-color-make-color-map ()
"Create a vector of face definitions and return it.
@@ -859,6 +983,7 @@ ansi-color-get-face-1
"Get face definition for ANSI-CODE.
BRIGHT, if non-nil, requests \"bright\" ANSI colors, even if ANSI-CODE
is a normal-intensity color."
+ (declare (obsolete ansi-color--face-vec-face "28.1"))
(when (and bright (<= 30 ansi-code 49))
(setq ansi-code (+ ansi-code 60)))
(cond ((<= 0 ansi-code 7)
--
2.33.0
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]
^ permalink raw reply related [flat|nested] 12+ messages in thread
* bug#50806: 27.2; [PATCH] Optimize ansi-color.el
2021-09-25 22:32 bug#50806: 27.2; [PATCH] Optimize ansi-color.el miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-03 16:31 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-10-03 17:53 ` Jim Porter
2021-10-03 19:54 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-03 19:59 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
1 sibling, 2 replies; 12+ messages in thread
From: Jim Porter @ 2021-10-03 17:53 UTC (permalink / raw)
To: miha, 50806; +Cc: Lars Ingebrigtsen
(Apologies for the delay in replying; the original message hit my spam
filter, and I only saw the followup. CC'ing Lars, who reviewed my
patches and can hopefully provide a more-helpful review than me with my
shaky Lisp skills.)
On 9/25/2021 3:32 PM, miha--- via Bug reports for GNU Emacs, the Swiss
army knife of text editors wrote:
> Attached patch speeds up ansi-color. It tries to eliminate as many
> allocations (cons and list) as possible.
>
> Benchmarks, recorded in emacs -q, are in the second attachments. With
> the patch applied, there is a 26% speedup in elapsed time, mostly
> because the garbage collector has to take care of less allocations.
Sounds good to me. I did some very light benchmarking on my patches, but
only to make sure I didn't make things too much slower (hopefully I
succeeded). Making it faster would definitely be nice.
> Two less important side notes:
>
> 1) This patch additionally makes it very straight forward to add support
> for ANSI color codes 38 and 48 allowing 256-colors and 24bit
> full-color. I plan to submit such a patch later (for both ansi-color
> and term-mode).
Glad to hear it! I was planning on doing this for Emacs 29, but if
you've already got something in mind for this, feel free to work on it.
Another thing that might be worth looking at would be improving
term.el's support for "basic" ANSI escapes; I think it only does bold,
underline, and inverse. Also, the inverse implementation seems a bit
over-complicated when it could just use the :inverse-video face
attribute instead.
> 2) Two vector variables, that were recently added by Jim, were merged
> into one. Adding him as CC.
I see you posted an updated patch that doesn't merge these vectors. I
don't have an opinion here, although if we do merge them, it would
probably be nice to get that into Emacs 28; other packages might
conceivably want to let-bind those[1].
[1] See man.el, which let-binds `ansi-color-basic-faces-vector' in
`Man-fontify-manpage'. That's for the basic faces, not the colors, but
the same idea should apply.
^ permalink raw reply [flat|nested] 12+ messages in thread
* bug#50806: 27.2; [PATCH] Optimize ansi-color.el
2021-10-03 17:53 ` Jim Porter
@ 2021-10-03 19:54 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-03 20:16 ` Jim Porter
2021-10-03 19:59 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
1 sibling, 1 reply; 12+ messages in thread
From: miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-10-03 19:54 UTC (permalink / raw)
To: Jim Porter, 50806; +Cc: Lars Ingebrigtsen
[-- Attachment #1.1: Type: text/plain, Size: 1512 bytes --]
>> Two less important side notes:
>>
>> 1) This patch additionally makes it very straight forward to add support
>> for ANSI color codes 38 and 48 allowing 256-colors and 24bit
>> full-color. I plan to submit such a patch later (for both ansi-color
>> and term-mode).
>
> Glad to hear it! I was planning on doing this for Emacs 29, but if
> you've already got something in mind for this, feel free to work on
> it. Another thing that might be worth looking at would be improving
> term.el's support for "basic" ANSI escapes; I think it only does bold,
> underline, and inverse. Also, the inverse implementation seems a bit
> over-complicated when it could just use the :inverse-video face
> attribute instead.
>
Ok, thanks. I have actually already prepared patches for all these
features: full-color in ansi-color.el and term.el and also "basic" ANSI
escapes 1-8 for term.el that you mentioned.
I guess there's no harm in sending them right now.
>> 2) Two vector variables, that were recently added by Jim, were merged
>> into one. Adding him as CC.
>
> I see you posted an updated patch that doesn't merge these vectors. I
> don't have an opinion here, although if we do merge them, it would
> probably be nice to get that into Emacs 28; other packages might
> conceivably want to let-bind those[1].
Indeed, if we wanted to merge them we'd have to do it in Emacs 28.
That's why I think its best to simply leave them un-merged.
Thanks and best regards.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0002-Add-support-for-256-color-and-24bit-ANSI-colors-in-a.patch --]
[-- Type: text/x-patch, Size: 6750 bytes --]
From cc7c1a4888b6e4dfda3a370ce357d0029b6448cc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Sat, 2 Oct 2021 23:13:21 +0200
Subject: [PATCH 2/4] Add support for 256-color and 24bit ANSI colors in
ansi-color
* lisp/ansi-color.el (ansi-color--code-as-hex): New function to
convert from 256-color and 24-bit ANSI codes.
(ansi-color--face-vec-face): Add support for ANSI color codes greater
than 16
(ansi-color--update-face-vec): Add support for ANSI codes 38 and 48
which can specify 256-color and 24bit ANSI colors.
* test/lisp/ansi-color-tests.el (ansi-color-tests--strings): Add tests
for ANSI codes 38 and 34
---
etc/NEWS | 7 ++++
lisp/ansi-color.el | 70 ++++++++++++++++++++++++++++-------
test/lisp/ansi-color-tests.el | 12 +++++-
3 files changed, 74 insertions(+), 15 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 8c22230daf..e862b77563 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -65,6 +65,13 @@ binding in the menu.
** subr-x
*** New macro 'with-memoization' provides a very primitive form of memoization
+** ansi-color.el
+
+---
+*** Support for ANSI 256-color and 24-bit colors.
+256-color and 24-bit color codes are now handled by ANSI color
+filters and displayed with the specified color.
+
\f
* New Modes and Packages in Emacs 29.1
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 7b46754d83..8d394f353b 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -594,22 +594,24 @@ ansi-color--face-vec-face
(when-let ((fg (car colors)))
(push
`(:foreground
- ,(face-foreground
- (aref (if (or bright (>= fg 8))
- ansi-color-bright-colors-vector
- ansi-color-normal-colors-vector)
- (mod fg 8))
- nil 'default))
+ ,(or (ansi-color--code-as-hex fg)
+ (face-foreground
+ (aref (if (or bright (>= fg 8))
+ ansi-color-bright-colors-vector
+ ansi-color-normal-colors-vector)
+ (mod fg 8))
+ nil 'default)))
faces))
(when-let ((bg (cadr colors)))
(push
`(:background
- ,(face-background
- (aref (if (or bright (>= bg 8))
- ansi-color-bright-colors-vector
- ansi-color-normal-colors-vector)
- (mod bg 8))
- nil 'default))
+ ,(or (ansi-color--code-as-hex bg)
+ (face-background
+ (aref (if (or bright (>= bg 8))
+ ansi-color-bright-colors-vector
+ ansi-color-normal-colors-vector)
+ (mod bg 8))
+ nil 'default)))
faces))
(let ((i 8))
@@ -622,6 +624,32 @@ ansi-color--face-vec-face
faces
(car faces))))
+(defun ansi-color--code-as-hex (color)
+ "Convert COLOR to hexadecimal string representation.
+COLOR is an ANSI color code. If it is between 16 and 255
+inclusive, it corresponds to a color from an 8-bit color cube.
+If it is greater or equal than 256, it is subtracted by 256 to
+directly specify a 24-bit color.
+
+Return a hexadecimal string, specifying the color, or nil, if
+COLOR is less than 16."
+ (cond
+ ((< color 16) nil)
+ ((>= color 256) (format "#%06X" (- color 256)))
+ ((>= color 232) ;; Grayscale
+ (format "#%06X" (* #x010101 (+ 8 (* 10 (- color 232))))))
+ (t ;; 6x6x6 color cube
+ (setq color (- color 16))
+ (let ((res 0)
+ (frac (* 6 6)))
+ (while (<= 1 frac) ; Repeat 3 times
+ (setq res (* res #x000100))
+ (let ((color-num (mod (/ color frac) 6)))
+ (unless (zerop color-num)
+ (setq res (+ res #x37 (* #x28 color-num)))))
+ (setq frac (/ frac 6)))
+ (format "#%06X" res)))))
+
;; Working with regions
(defvar-local ansi-color-context-region nil
@@ -907,7 +935,23 @@ ansi-color--update-face-vec
(let ((r (mod new 10))
(cell (if (memq q '(3 9)) colors (cdr colors))))
(pcase r
- (8 (setq do-clear t))
+ (8
+ (pcase (funcall iterator)
+ (5 (setq new (setcar cell (funcall iterator)))
+ (setq do-clear (or (null new) (>= new 256))))
+ (2
+ (let ((red (funcall iterator))
+ (green (funcall iterator))
+ (blue (funcall iterator)))
+ (if (and red green blue
+ (progn
+ (setq new (+ (* #x010000 red)
+ (* #x000100 green)
+ (* #x000001 blue)))
+ (<= new #xFFFFFF)))
+ (setcar cell (+ 256 new))
+ (setq do-clear t))))
+ (_ (setq do-clear t))))
(9 (setcar cell nil))
(_ (setcar cell (+ (if (memq q '(3 4)) 0 8) r))))))
(_ (setq do-clear t)))
diff --git a/test/lisp/ansi-color-tests.el b/test/lisp/ansi-color-tests.el
index 953fdff893..16a1ba4a89 100644
--- a/test/lisp/ansi-color-tests.el
+++ b/test/lisp/ansi-color-tests.el
@@ -27,7 +27,8 @@
(defvar ansi-color-tests--strings
(let ((bright-yellow (face-foreground 'ansi-color-bright-yellow nil 'default))
- (yellow (face-foreground 'ansi-color-yellow nil 'default)))
+ (yellow (face-foreground 'ansi-color-yellow nil 'default))
+ (custom-color "#87FFFF"))
`(("Hello World" "Hello World")
("\e[33mHello World\e[0m" "Hello World"
(:foreground ,yellow))
@@ -51,7 +52,14 @@ ansi-color-tests--strings
(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"))))
+ ("\e[10munrecognized\e[0m" "unrecognized")
+ ("\e[38;5;3;1mHello World\e[0m" "Hello World"
+ (ansi-color-bold (:foreground ,yellow))
+ (ansi-color-bold (:foreground ,bright-yellow)))
+ ("\e[48;5;123;1mHello World\e[0m" "Hello World"
+ (ansi-color-bold (:background ,custom-color)))
+ ("\e[48;2;135;255;255;1mHello World\e[0m" "Hello World"
+ (ansi-color-bold (:background ,custom-color))))))
(ert-deftest ansi-color-apply-on-region-test ()
(pcase-dolist (`(,input ,text ,face) ansi-color-tests--strings)
--
2.33.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.3: 0003-Add-support-for-256-color-and-24bit-ANSI-colors-in-t.patch --]
[-- Type: text/x-patch, Size: 18727 bytes --]
From ad667c79926f28c5e82654c9f99dc23f41e9375e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Sat, 25 Sep 2021 23:28:08 +0200
Subject: [PATCH 3/4] Add support for 256-color and 24bit ANSI colors in
term-mode
(term-ansi-face-already-done): Make obsolete
(term--maybe-brighten-color): Remove
(term--color-as-hex): New function
(term-handle-colors-array): Make obsolete in favour of the new
function 'term--handle-colors-list'.
(term--handle-colors-list): New function, that can also handle ANSI
codes 38 and 48.
(term-handle-ansi-escape): Use it
* test/lisp/term-tests.el (ansi-test-strings): Add tests for 256-color
and 24bit ANSI colors
---
etc/NEWS | 7 ++
etc/e/README | 18 +--
etc/e/eterm-color | Bin 1179 -> 1275 bytes
etc/e/eterm-color.ti | 15 ++-
etc/e/eterm-direct | Bin 0 -> 1354 bytes
lisp/term.el | 249 +++++++++++++++++++---------------------
test/lisp/term-tests.el | 16 ++-
7 files changed, 163 insertions(+), 142 deletions(-)
create mode 100644 etc/e/eterm-direct
diff --git a/etc/NEWS b/etc/NEWS
index e862b77563..e22eac5e75 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -72,6 +72,13 @@ binding in the menu.
256-color and 24-bit color codes are now handled by ANSI color
filters and displayed with the specified color.
+** term-mode
+
+---
+*** Support for ANSI 256-color and 24-bit colors.
+256-color and 24-bit color codes are now displayed with the specified
+color.
+
\f
* New Modes and Packages in Emacs 29.1
diff --git a/etc/e/README b/etc/e/README
index dd2c8d64e2..1293292a87 100644
--- a/etc/e/README
+++ b/etc/e/README
@@ -1,12 +1,12 @@
-eterm-color.ti is a terminfo source file. eterm-color is a compiled
-version produced by the terminfo compiler (tic). The compiled files
-are binary, and depend on the version of tic, but they seem to be
-system-independent and backwardly compatible. So there should be no
-need to recompile the distributed binary version. If it is
-necessary, use:
+eterm-color.ti is a terminfo source file. eterm-color and
+eterm-direct are compiled versions produced by the terminfo compiler
+(tic). The compiled files are binary, and depend on the version of
+tic, but they seem to be system-independent and backwardly compatible.
+So there should be no need to recompile the distributed binary
+version. If it is necessary, use:
tic -o ../ ./eterm-color.ti
-The compiled file is used by lisp/term.el, so if it is moved term.el
-needs to be changed. terminfo requires it to be stored in an 'e'
-subdirectory (the first character of the file name).
+The compiled files are used by lisp/term.el, so if they are moved,
+term.el needs to be changed. terminfo requires them to be stored in
+an 'e' subdirectory (the first character of the file name).
diff --git a/etc/e/eterm-color b/etc/e/eterm-color
index bd3f5003ae620db49b89a2c1387b0ba1c836f4f1..99603ba5613b822d9916df63b7c1fcc6833a038d 100644
GIT binary patch
delta 160
zcmbQu`J0nliqV~c9|$uUS5D+EWMN?ZU%#>80uy8A=0IjW#u|Io0z=hmi&|A1)e>V6
tJ4H1WEM#Z~7PExO>w;vAEv!wgA*!r%8Kk3Ck+qv((QasfqTd8XKLBEMDcJx3
delta 64
zcmey(Ih&JPiqV~c9|$uUJtuM(vT!gsFl=nNz{F^^IgnY8QKrC9wc6OAR#jUyC6_@u
MS{2Aw*HDLW0nn2UQ~&?~
diff --git a/etc/e/eterm-color.ti b/etc/e/eterm-color.ti
index a6ef814990..61c29e6dcc 100644
--- a/etc/e/eterm-color.ti
+++ b/etc/e/eterm-color.ti
@@ -9,10 +9,10 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96,
# Any change to this file should be done at the same time with a
# corresponding change to the TERMCAP environment variable in term.el.
# Comments in term.el specify where each of these capabilities is implemented.
- colors#8,
+ colors#256,
cols#80,
lines#24,
- pairs#64,
+ pairs#32767,
am,
mir,
msgr,
@@ -65,8 +65,8 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96,
rmul=\E[24m,
rs1=\Ec,
sc=\E7,
- setab=\E[%p1%{40}%+%dm,
- setaf=\E[%p1%{30}%+%dm,
+ setab=\E[%?%p1%{8}%<%t4%p1%d%e%p1%{16}%<%t10%p1%{8}%-%d%e48;5;%p1%d%;m,
+ setaf=\E[%?%p1%{8}%<%t3%p1%d%e%p1%{16}%<%t9%p1%{8}%-%d%e38;5;%p1%d%;m,
sgr0=\E[m,
smir=\E[4h,
smul=\E[4m,
@@ -76,3 +76,10 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96,
# smcup=\E[?47h,
# rmcup=\E[?47l,
# rs2 may need to be added
+
+eterm-direct|Emacs term.el with direct-color indexing term-protocol-version 0.96,
+ use=eterm-color,
+ colors#0x1000000,
+ pairs#0x10000,
+ setab=\E[%?%p1%{8}%<%t4%p1%d%e48;2;%p1%{65536}%/%d;%p1%{256}%/%{255}%&%d;%p1%{255}%&%d%;m,
+ setaf=\E[%?%p1%{8}%<%t3%p1%d%e38;2;%p1%{65536}%/%d;%p1%{256}%/%{255}%&%d;%p1%{255}%&%d%;m,
diff --git a/etc/e/eterm-direct b/etc/e/eterm-direct
new file mode 100644
index 0000000000000000000000000000000000000000..35983ec8aded7b0c6b818df47abe57b9440934cb
GIT binary patch
literal 1354
zcmcgoJ!lkB5T18LqCpW0LD(QG_$&e!z5Tm8HbJ8aM9q<y#^P+k?P?b9Zja4kLgJ}~
z*jU)uq_DBEu&}jFYZXXqYilb6!urkJo~H&hA>!MenQy-Nd-Kj0?$Bv`k=j;a8YZn`
z5G7$FeLT}zYOI*djE7BgHA<JwUZmKFn{i@B?I2u>+7Be9*h%6vMxgj8Oje?}ZC)9#
zdPGWolB3iDY=(0#w~YUGkSa~GjHp0Es6R`iWJ;fl<Wd>P7jF`J3Nk}C#plko94*pa
zpnJ4L_l0>VI;ND?^Nhhgo`HFuvoBy@?#meDX4xxxjrb<y4ZWpzdG7l^*7WK>&_~*$
zPsrS%&-4ZM>u*)xa(@?g5ARS=y~<;`{rMgT#luIaJ?M=8n|Jb%8=X<3QgPvsb^mg!
zG1XPWbc&3+j&!G_17CM69V8%TjruK^+Yq+D#Aj)QGw3+<4agK^0aAmMT2Rh1RE1Ib
zhjJK6unAyEz!Gwfo`SKTkTHK9paf92*qa9M*mK##q<Nks7v*sRYJI?^!d&Zvxjx`N
z65`7WK%WK~6*9`aN{vn+;P9jpFN|gJ62T&%*M_pIzEkC^>#JP7QR(Ulo!Zh#hjzuc
keBnLUwY{#sEboXs%M}mS?dnSdw&!VoUrQ%%=^UZucQ(5!9smFU
literal 0
HcmV?d00001
diff --git a/lisp/term.el b/lisp/term.el
index e76eb77647..771b73238f 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -303,6 +303,7 @@ term-protocol-version
(require 'ange-ftp)
(require 'cl-lib))
(require 'comint) ; Password regexp.
+(require 'ansi-color)
(require 'ehelp)
(require 'ring)
(require 'shell)
@@ -717,6 +718,9 @@ term-ansi-current-underline
(defvar term-ansi-current-reverse nil)
(defvar term-ansi-current-invisible nil)
+(make-obsolete-variable 'term-ansi-face-already-done
+ "it doesn't have any effect." "28.1")
+
;;; Faces
(defvar ansi-term-color-vector
[term
@@ -1039,10 +1043,6 @@ term-ansi-reset
(setq term-ansi-current-reverse nil)
(setq term-ansi-current-color 0)
(setq term-ansi-current-invisible nil)
- ;; Stefan thought this should be t, but could not remember why.
- ;; Setting it to t seems to cause bug#11785. Setting it to nil
- ;; again to see if there are other consequences...
- (setq term-ansi-face-already-done nil)
(setq term-ansi-current-bg-color 0))
(define-derived-mode term-mode fundamental-mode "Term"
@@ -1584,7 +1584,8 @@ term-termcap-format
:so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\
:UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC\
:kl=\\EOD:kd=\\EOB:kr=\\EOC:ku=\\EOA:kN=\\E[6~:kP=\\E[5~:@7=\\E[4~:kh=\\E[1~\
-:mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#8:pa#64:AB=\\E[4%%dm:AF=\\E[3%%dm:cr=^M\
+:mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#256:pa#32767\
+:AB=\\E[48;5;%%dm:AF=\\E[38;5;%%dm:cr=^M\
:bl=^G:do=^J:le=^H:ta=^I:se=\\E[27m:ue=\\E[24m\
:kb=^?:kD=^[[3~:sc=\\E7:rc=\\E8:r1=\\Ec:"
;; : -undefine ic
@@ -3285,133 +3286,125 @@ term-reset-terminal
(setq term-current-row 0)
(setq term-current-column 1)
(term--reset-scroll-region)
- (setq term-insert-mode nil)
- ;; 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))
+ (setq term-insert-mode nil))
+
+(defun term--color-as-hex (for-foreground)
+ "Return the current ANSI color as a hexadecimal color string.
+Use the current background color if FOR-FOREGROUND is nil,
+otherwise use the current foreground color."
+ (let ((color (if for-foreground term-ansi-current-color
+ term-ansi-current-bg-color)))
+ (or (ansi-color--code-as-hex (1- color))
+ (progn
+ (and ansi-color-bold-is-bright term-ansi-current-bold
+ (<= 1 color 8)
+ (setq color (+ color 8)))
+ (if for-foreground
+ (face-foreground (elt ansi-term-color-vector color)
+ nil 'default)
+ (face-background (elt ansi-term-color-vector color)
+ nil 'default))))))
;; New function to deal with ansi colorized output, as you can see you can
;; have any bold/underline/fg/bg/reverse combination. -mm
(defun term-handle-colors-array (parameter)
- (cond
-
- ;; Bold (terminfo: bold)
- ((eq parameter 1)
- (setq term-ansi-current-bold t))
-
- ;; Underline
- ((eq parameter 4)
- (setq term-ansi-current-underline t))
-
- ;; Blink (unsupported by Emacs), will be translated to bold.
- ;; This may change in the future though.
- ((eq parameter 5)
- (setq term-ansi-current-bold t))
-
- ;; Reverse (terminfo: smso)
- ((eq parameter 7)
- (setq term-ansi-current-reverse t))
-
- ;; Invisible
- ((eq parameter 8)
- (setq term-ansi-current-invisible t))
-
- ;; Reset underline (terminfo: rmul)
- ((eq parameter 24)
- (setq term-ansi-current-underline nil))
-
- ;; Reset reverse (terminfo: rmso)
- ((eq parameter 27)
- (setq term-ansi-current-reverse nil))
-
- ;; Foreground
- ((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))
-
- ;; Background
- ((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))
-
- ;; 0 (Reset) or unknown (reset anyway)
- (t
- (term-ansi-reset)))
-
- ;; (message "Debug: U-%d R-%d B-%d I-%d D-%d F-%d B-%d"
- ;; term-ansi-current-underline
- ;; term-ansi-current-reverse
- ;; term-ansi-current-bold
- ;; term-ansi-current-invisible
- ;; term-ansi-face-already-done
- ;; term-ansi-current-color
- ;; term-ansi-current-bg-color)
-
- (unless term-ansi-face-already-done
- (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
- (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))))))
-
- ;; (message "Debug %S" term-current-face)
- ;; FIXME: shouldn't we set term-ansi-face-already-done to t here? --Stef
- (setq term-ansi-face-already-done nil))
+ (declare (obsolete term--handle-colors-list "28.1"))
+ (term--handle-colors-list (list parameter)))
+
+(defun term--handle-colors-list (parameters)
+ (while parameters
+ (pcase (pop parameters)
+ (1 (setq term-ansi-current-bold t)) ; (terminfo: bold)
+ (4 (setq term-ansi-current-underline t)) ; (terminfo: smul)
+ (5 (setq term-ansi-current-bold t)) ; (terminfo: bold)
+ (7 (setq term-ansi-current-reverse t)) ; (terminfo: smso, rev)
+ (8 (setq term-ansi-current-invisible t)) ; (terminfo: invis)
+ (24 (setq term-ansi-current-underline nil)) ; (terminfo: rmul)
+ (27 (setq term-ansi-current-reverse nil)) ; (terminfo: rmso)
+
+ ;; Foreground (terminfo: setaf)
+ ((and param (guard (<= 30 param 37)))
+ (setq term-ansi-current-color (- param 29)))
+
+ ;; Bright foreground (terminfo: setaf)
+ ((and param (guard (<= 90 param 97)))
+ (setq term-ansi-current-color (- param 81)))
+
+ ;; Extended foreground (terminfo: setaf)
+ (38
+ (pcase (pop parameters)
+ ;; 256 color
+ (5 (if (setq term-ansi-current-color (pop parameters))
+ (cl-incf term-ansi-current-color)
+ (term-ansi-reset)))
+ ;; Full 24-bit color
+ (2 (cl-loop with color = (1+ 256) ; Base
+ for i from 16 downto 0 by 8
+ if (pop parameters)
+ do (setq color (+ color (ash it i)))
+ else return (term-ansi-reset)
+ finally
+ (if (> color (+ 1 256 #xFFFFFF))
+ (term-ansi-reset)
+ (setq term-ansi-current-color color))))
+ (_ (term-ansi-reset))))
+
+ ;; Reset foreground (terminfo: op)
+ (39 (setq term-ansi-current-color 0))
+
+ ;; Background (terminfo: setab)
+ ((and param (guard (<= 40 param 47)))
+ (setq term-ansi-current-bg-color (- param 39)))
+
+ ;; Bright background (terminfo: setab)
+ ((and param (guard (<= 100 param 107)))
+ (setq term-ansi-current-bg-color (- param 91)))
+
+ ;; Extended background (terminfo: setab)
+ (48
+ (pcase (pop parameters)
+ ;; 256 color
+ (5 (if (setq term-ansi-current-bg-color (pop parameters))
+ (cl-incf term-ansi-current-bg-color)
+ (term-ansi-reset)))
+ ;; Full 24-bit color
+ (2 (cl-loop with color = (1+ 256) ; Base
+ for i from 16 downto 0 by 8
+ if (pop parameters)
+ do (setq color (+ color (ash it i)))
+ else return (term-ansi-reset)
+ finally
+ (if (> color (+ 1 256 #xFFFFFF))
+ (term-ansi-reset)
+ (setq term-ansi-current-bg-color color))))
+ (_ (term-ansi-reset))))
+
+ ;; Reset background (terminfo: op)
+ (49 (setq term-ansi-current-bg-color 0))
+
+ ;; 0 (Reset) (terminfo: sgr0) or unknown (reset anyway)
+ (_ (term-ansi-reset))))
+
+ (let (fg bg)
+ (if term-ansi-current-invisible
+ (setq bg (term--color-as-hex term-ansi-current-reverse)
+ fg bg)
+ (setq fg (term--color-as-hex t)
+ bg (term--color-as-hex nil)))
+ (setq term-current-face
+ `( :foreground ,fg
+ :background ,bg
+ ,@(unless term-ansi-current-invisible
+ (list :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))))
;; Handle a character assuming (eq terminal-state 2) -
@@ -3499,7 +3492,7 @@ term-handle-ansi-escape
;; \E[m - Set/reset modes, set bg/fg
;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf)
((eq char ?m)
- (mapc #'term-handle-colors-array params))
+ (term--handle-colors-list params))
;; \E[6n - Report cursor position (terminfo: u7)
((eq char ?n)
diff --git a/test/lisp/term-tests.el b/test/lisp/term-tests.el
index 96b6d73488..b8adc62c9d 100644
--- a/test/lisp/term-tests.el
+++ b/test/lisp/term-tests.el
@@ -42,6 +42,9 @@ bright-yellow-bg-props
`( :foreground "unspecified-fg"
:background ,(face-background 'term-color-bright-yellow nil 'default)
:inverse-video nil))
+(defvar custom-color-fg-props
+ `( :foreground "#87FFFF"
+ :background "unspecified-bg" :inverse-video nil))
(defvar ansi-test-strings
`(("\e[33mHello World\e[0m"
@@ -71,7 +74,18 @@ ansi-test-strings
,(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)))))
+ `(,bright-yellow-fg-props :inherit term-bold)))
+ ("\e[38;5;3;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[38;5;123;1mHello World\e[0m"
+ ,(propertize "Hello World" 'font-lock-face
+ `(,custom-color-fg-props :inherit term-bold)))
+ ("\e[38;2;135;255;255;1mHello World\e[0m"
+ ,(propertize "Hello World" 'font-lock-face
+ `(,custom-color-fg-props :inherit term-bold)))))
(defun term-test-screen-from-input (width height input &optional return-var)
(with-temp-buffer
--
2.33.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.4: 0004-In-term-mode-handle-ANSI-codes-specifying-italic-and.patch --]
[-- Type: text/x-patch, Size: 15659 bytes --]
From d1b256c98b658231cc4bbec83c7e3c2a44601dc3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Mon, 27 Sep 2021 15:15:57 +0200
Subject: [PATCH 4/4] In term-mode, handle ANSI codes, specifying italic and
other modes
* etc/e/eterm-color.ti: Add new capabilities
* lisp/term.el: New faces and variables to support new ANSI modes.
(term-termcap-format): Add new capabilities
(term-emulate-terminal): When saving cursor, additionally save the new
variables.
(term--handle-colors-list): Handle ANSI codes, specifying italic other
modes.
* test/lisp/term-tests.el (ansi-test-strings): Adjust tests.
---
etc/NEWS | 8 +--
etc/e/eterm-color | Bin 1275 -> 1296 bytes
etc/e/eterm-color.ti | 4 ++
etc/e/eterm-direct | Bin 1354 -> 1375 bytes
lisp/term.el | 105 ++++++++++++++++++++++++++++++----------
test/lisp/term-tests.el | 32 ++++++------
6 files changed, 104 insertions(+), 45 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index e22eac5e75..4b6a25c1e7 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -75,9 +75,11 @@ filters and displayed with the specified color.
** term-mode
---
-*** Support for ANSI 256-color and 24-bit colors.
-256-color and 24-bit color codes are now displayed with the specified
-color.
+*** Support for ANSI 256-color and 24-bit colors, italic and other fonts.
+Term-mode can now display 256-color and 24-bit color codes. It can
+also handle ANSI codes for faint, italic and blinking text, displaying
+it with new 'ansi-term-faint/italic/slow-blinking/fast-blinking'
+faces.
\f
* New Modes and Packages in Emacs 29.1
diff --git a/etc/e/eterm-color b/etc/e/eterm-color
index 99603ba5613b822d9916df63b7c1fcc6833a038d..bf44fa0f36de0f6681fa3172db13a83c414aa42a 100644
GIT binary patch
delta 286
zcmey(If08?iqV~c9|$uU_f6zp>EX)|#PA;o!Wm*15`nBVhHQocut+JGtYoNTXaTc8
zs$ifCDAETNodBe#GE6pPl#!UpFb~LC48+SB)-Y^@D%i>}c_O2d%}$0x45t~c00r+d
zJY#qdq<=saz)WRigs@nEG&>^~BM+3%&p7!aqZN}Nh&nl0fRUX^j1g$09+xzu8d!-o
zBhY#&F%zhIn0X-D5~RtC*`Bd(av*a6w`neebhIIeFq*uG`3}1=m}xw@ilq?%rk#|p
delta 241
zcmbQh^_!DhiqV~c9|$uUS5D+!>GA)+FT;N@2x15avSJt#8PdQa*<doCp@g9dssf@8
zL^c3LTA-qBK)Rb@vLU04L_fn6AZI2J&t+J|upFvjHN)hIj7m1^8FnxnWH<#Byv%Ti
z;VF=Q2UP$w_dAsT3rPQEU|?iogvhWmPQJ)!#l#MxPEHnJWM|@G1RANwCCDfPR-y=!
Ysbbb*%$yv^9KdKec@6WO$&*=X0X>z1egFUf
diff --git a/etc/e/eterm-color.ti b/etc/e/eterm-color.ti
index 61c29e6dcc..eeb9b0b6e6 100644
--- a/etc/e/eterm-color.ti
+++ b/etc/e/eterm-color.ti
@@ -18,6 +18,7 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96,
msgr,
xenl,
bel=^G,
+ blink=\E[5m,
bold=\E[1m,
clear=\E[H\E[J,
cr=\r,
@@ -31,6 +32,7 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96,
cup=\E[%i%p1%d;%p2%dH,
cuu1=\E[A,
cuu=\E[%p1%dA,
+ dim=\E[2m,
dch1=\E[P,
dch=\E[%p1%dP,
dl1=\E[M,
@@ -60,6 +62,7 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96,
rc=\E8,
rev=\E[7m,
ri=\EM,
+ ritm=\E[23m,
rmir=\E[4l,
rmso=\E[27m,
rmul=\E[24m,
@@ -68,6 +71,7 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96,
setab=\E[%?%p1%{8}%<%t4%p1%d%e%p1%{16}%<%t10%p1%{8}%-%d%e48;5;%p1%d%;m,
setaf=\E[%?%p1%{8}%<%t3%p1%d%e%p1%{16}%<%t9%p1%{8}%-%d%e38;5;%p1%d%;m,
sgr0=\E[m,
+ sitm=\E[3m,
smir=\E[4h,
smul=\E[4m,
smso=\E[7m,
diff --git a/etc/e/eterm-direct b/etc/e/eterm-direct
index 35983ec8aded7b0c6b818df47abe57b9440934cb..c113c3713693b948ae9d52e75df5d89957fd0c77 100644
GIT binary patch
delta 262
zcmX@bb)Sn{jwz6V9|$uUpHAey=;6x{#PA;o!Wm*15`nBVhHQocut+JGtYoNTXaTc8
zs$ifCDAETNodBe#GE8igk(kLa56E5&#LF4hFl>a%Z)KQ#kWtBcC&M9z(+pRDf_E97
zF}w%TKcEU=hB7ijSS&!Aoso-?2g>K4{E^X`Q4mO8WE2CE`kc~?YG65SAWxdn1V{=q
oS^`OLW_!j-lPj46xJ`2zq@xW%gwf<v%y-z0!A#@Hi&$0w0G2X_$p8QV
delta 232
zcmcc5b&88yjwz6V9|$uUFHGdV=<)x*FT;N@2x15avSJt#8PdQa*<doCp@g9dssf@8
zL^c3LTA-qBK)Rb@Vxx>iKf@FtdnORiWmv?p94fz>Ve&ynCF}JJI~Wc!oB|47X1K%f
z6iB~=Du5aL9m@X&r2jH7FfuVhWLPJEWVB{v2a*>Vd4Qxory!#YSWXeht7g_>tesrR
R9KdKe`3m!$$-7yW000mDghK!T
diff --git a/lisp/term.el b/lisp/term.el
index 771b73238f..ce086c379b 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -711,10 +711,14 @@ term-ansi-at-save-user
(defvar term-ansi-at-save-pwd nil)
(defvar term-ansi-at-save-anon nil)
(defvar term-ansi-current-bold nil)
+(defvar term-ansi-current-faint nil)
+(defvar term-ansi-current-italic nil)
+(defvar term-ansi-current-underline nil)
+(defvar term-ansi-current-slow-blink nil)
+(defvar term-ansi-current-fast-blink nil)
(defvar term-ansi-current-color 0)
(defvar term-ansi-face-already-done nil)
(defvar term-ansi-current-bg-color 0)
-(defvar term-ansi-current-underline nil)
(defvar term-ansi-current-reverse nil)
(defvar term-ansi-current-invisible nil)
@@ -769,12 +773,36 @@ term-bold
:group 'term
:version "28.1")
+(defface term-faint
+ '((t :inherit ansi-color-faint))
+ "Default face to use for faint text."
+ :group 'term
+ :version "28.1")
+
+(defface term-italic
+ '((t :inherit ansi-color-italic))
+ "Default face to use for italic text."
+ :group 'term
+ :version "28.1")
+
(defface term-underline
'((t :inherit ansi-color-underline))
"Default face to use for underlined text."
:group 'term
:version "28.1")
+(defface term-slow-blink
+ '((t :inherit ansi-color-slow-blink))
+ "Default face to use for slowly blinking text."
+ :group 'term
+ :version "28.1")
+
+(defface term-fast-blink
+ '((t :inherit ansi-color-fast-blink))
+ "Default face to use for rapidly blinking text."
+ :group 'term
+ :version "28.1")
+
(defface term-color-black
'((t :inherit ansi-color-black))
"Face used to render black color code."
@@ -1038,8 +1066,12 @@ term-display-table
(defun term-ansi-reset ()
(setq term-current-face 'term)
- (setq term-ansi-current-underline nil)
(setq term-ansi-current-bold nil)
+ (setq term-ansi-current-faint nil)
+ (setq term-ansi-current-italic nil)
+ (setq term-ansi-current-underline nil)
+ (setq term-ansi-current-slow-blink nil)
+ (setq term-ansi-current-fast-blink nil)
(setq term-ansi-current-reverse nil)
(setq term-ansi-current-color 0)
(setq term-ansi-current-invisible nil)
@@ -1581,6 +1613,7 @@ term-termcap-format
:nd=\\E[C:up=\\E[A:ce=\\E[K:ho=\\E[H:pt\
:al=\\E[L:dl=\\E[M:DL=\\E[%%dM:AL=\\E[%%dL:cs=\\E[%%i%%d;%%dr:sf=^J\
:dc=\\E[P:DC=\\E[%%dP:IC=\\E[%%d@:im=\\E[4h:ei=\\E[4l:mi:\
+:mb=\\E[5m:mh=\\E[2m:ZR=\\E[23m:ZH=\\E[3m\
:so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\
:UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC\
:kl=\\EOD:kd=\\EOB:kr=\\EOC:ku=\\EOA:kN=\\E[6~:kP=\\E[5~:@7=\\E[4~:kh=\\E[1~\
@@ -3105,30 +3138,34 @@ term-emulate-terminal
(term-horizontal-column)
term-ansi-current-bg-color
term-ansi-current-bold
+ term-ansi-current-faint
+ term-ansi-current-italic
+ term-ansi-current-underline
+ term-ansi-current-slow-blink
+ term-ansi-current-fast-blink
term-ansi-current-color
term-ansi-current-invisible
term-ansi-current-reverse
- term-ansi-current-underline
term-current-face)))
(?8 ;; Restore cursor (terminfo: rc, [ctlseqs]
;; "DECRC").
(when term-saved-cursor
(term-goto (nth 0 term-saved-cursor)
(nth 1 term-saved-cursor))
- (setq term-ansi-current-bg-color
- (nth 2 term-saved-cursor)
- term-ansi-current-bold
- (nth 3 term-saved-cursor)
- term-ansi-current-color
- (nth 4 term-saved-cursor)
- term-ansi-current-invisible
- (nth 5 term-saved-cursor)
- term-ansi-current-reverse
- (nth 6 term-saved-cursor)
- term-ansi-current-underline
- (nth 7 term-saved-cursor)
- term-current-face
- (nth 8 term-saved-cursor))))
+ (pcase-setq
+ `( ,_ ,_
+ ,term-ansi-current-bg-color
+ ,term-ansi-current-bold
+ ,term-ansi-current-faint
+ ,term-ansi-current-italic
+ ,term-ansi-current-underline
+ ,term-ansi-current-slow-blink
+ ,term-ansi-current-fast-blink
+ ,term-ansi-current-color
+ ,term-ansi-current-invisible
+ ,term-ansi-current-reverse
+ ,term-current-face)
+ term-saved-cursor)))
(?c ;; \Ec - Reset (terminfo: rs1, [ctlseqs] "RIS").
;; This is used by the "clear" program.
(term-reset-terminal))
@@ -3316,11 +3353,20 @@ term--handle-colors-list
(while parameters
(pcase (pop parameters)
(1 (setq term-ansi-current-bold t)) ; (terminfo: bold)
+ (2 (setq term-ansi-current-faint t)) ; (terminfo: dim)
+ (3 (setq term-ansi-current-italic t)) ; (terminfo: sitm)
(4 (setq term-ansi-current-underline t)) ; (terminfo: smul)
- (5 (setq term-ansi-current-bold t)) ; (terminfo: bold)
+ (5 (setq term-ansi-current-slow-blink t)) ; (terminfo: blink)
+ (6 (setq term-ansi-current-fast-blink t))
(7 (setq term-ansi-current-reverse t)) ; (terminfo: smso, rev)
(8 (setq term-ansi-current-invisible t)) ; (terminfo: invis)
+ (21 (setq term-ansi-current-bold nil))
+ (22 (setq term-ansi-current-bold nil)
+ (setq term-ansi-current-faint nil))
+ (23 (setq term-ansi-current-italic nil)) ; (terminfo: ritm)
(24 (setq term-ansi-current-underline nil)) ; (terminfo: rmul)
+ (25 (setq term-ansi-current-slow-blink nil)
+ (setq term-ansi-current-fast-blink nil))
(27 (setq term-ansi-current-reverse nil)) ; (terminfo: rmso)
;; Foreground (terminfo: setaf)
@@ -3398,13 +3444,20 @@ term--handle-colors-list
,@(unless term-ansi-current-invisible
(list :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))))
+ (setq term-current-face
+ `(,term-current-face
+ ,@(when term-ansi-current-bold
+ '(term-bold))
+ ,@(when term-ansi-current-faint
+ '(term-faint))
+ ,@(when term-ansi-current-italic
+ '(term-italic))
+ ,@(when term-ansi-current-underline
+ '(term-underline))
+ ,@(when term-ansi-current-slow-blink
+ '(term-slow-blink))
+ ,@(when term-ansi-current-fast-blink
+ '(term-fast-blink)))))
;; Handle a character assuming (eq terminal-state 2) -
@@ -3490,7 +3543,7 @@ term-handle-ansi-escape
;; Modified to allow ansi coloring -mm
;; \E[m - Set/reset modes, set bg/fg
- ;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf)
+ ;;(terminfo: smso,rmso,smul,rmul,rev,bold,dim,sitm,ritm,blink,sgr0,invis,op,setab,setaf)
((eq char ?m)
(term--handle-colors-list params))
diff --git a/test/lisp/term-tests.el b/test/lisp/term-tests.el
index b8adc62c9d..73d39cf3b6 100644
--- a/test/lisp/term-tests.el
+++ b/test/lisp/term-tests.el
@@ -48,44 +48,44 @@ custom-color-fg-props
(defvar ansi-test-strings
`(("\e[33mHello World\e[0m"
- ,(propertize "Hello World" 'font-lock-face yellow-fg-props))
+ ,(propertize "Hello World" 'font-lock-face `(,yellow-fg-props)))
("\e[43mHello World\e[0m"
- ,(propertize "Hello World" 'font-lock-face yellow-bg-props))
+ ,(propertize "Hello World" 'font-lock-face `(,yellow-bg-props)))
("\e[93mHello World\e[0m"
- ,(propertize "Hello World" 'font-lock-face bright-yellow-fg-props))
+ ,(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))
+ ,(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))
+ `(,yellow-fg-props term-bold))
,(propertize "Hello World" 'font-lock-face
- `(,bright-yellow-fg-props :inherit term-bold)))
+ `(,bright-yellow-fg-props term-bold)))
("\e[33;1mHello World\e[0m"
,(propertize "Hello World" 'font-lock-face
- `(,yellow-fg-props :inherit term-bold))
+ `(,yellow-fg-props term-bold))
,(propertize "Hello World" 'font-lock-face
- `(,bright-yellow-fg-props :inherit term-bold)))
+ `(,bright-yellow-fg-props term-bold)))
("\e[1m\e[33mHello World\e[0m"
,(propertize "Hello World" 'font-lock-face
- `(,yellow-fg-props :inherit term-bold))
+ `(,yellow-fg-props term-bold))
,(propertize "Hello World" 'font-lock-face
- `(,bright-yellow-fg-props :inherit term-bold)))
+ `(,bright-yellow-fg-props term-bold)))
("\e[33m\e[1mHello World\e[0m"
,(propertize "Hello World" 'font-lock-face
- `(,yellow-fg-props :inherit term-bold))
+ `(,yellow-fg-props term-bold))
,(propertize "Hello World" 'font-lock-face
- `(,bright-yellow-fg-props :inherit term-bold)))
+ `(,bright-yellow-fg-props term-bold)))
("\e[38;5;3;1mHello World\e[0m"
,(propertize "Hello World" 'font-lock-face
- `(,yellow-fg-props :inherit term-bold))
+ `(,yellow-fg-props term-bold))
,(propertize "Hello World" 'font-lock-face
- `(,bright-yellow-fg-props :inherit term-bold)))
+ `(,bright-yellow-fg-props term-bold)))
("\e[38;5;123;1mHello World\e[0m"
,(propertize "Hello World" 'font-lock-face
- `(,custom-color-fg-props :inherit term-bold)))
+ `(,custom-color-fg-props term-bold)))
("\e[38;2;135;255;255;1mHello World\e[0m"
,(propertize "Hello World" 'font-lock-face
- `(,custom-color-fg-props :inherit term-bold)))))
+ `(,custom-color-fg-props term-bold)))))
(defun term-test-screen-from-input (width height input &optional return-var)
(with-temp-buffer
--
2.33.0
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]
^ permalink raw reply related [flat|nested] 12+ messages in thread
* bug#50806: 27.2; [PATCH] Optimize ansi-color.el
2021-10-03 17:53 ` Jim Porter
2021-10-03 19:54 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-10-03 19:59 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-04 9:27 ` Lars Ingebrigtsen
1 sibling, 1 reply; 12+ messages in thread
From: miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-10-03 19:59 UTC (permalink / raw)
To: Jim Porter, 50806; +Cc: Lars Ingebrigtsen
[-- Attachment #1.1: Type: text/plain, Size: 1512 bytes --]
>> Two less important side notes:
>>
>> 1) This patch additionally makes it very straight forward to add support
>> for ANSI color codes 38 and 48 allowing 256-colors and 24bit
>> full-color. I plan to submit such a patch later (for both ansi-color
>> and term-mode).
>
> Glad to hear it! I was planning on doing this for Emacs 29, but if
> you've already got something in mind for this, feel free to work on
> it. Another thing that might be worth looking at would be improving
> term.el's support for "basic" ANSI escapes; I think it only does bold,
> underline, and inverse. Also, the inverse implementation seems a bit
> over-complicated when it could just use the :inverse-video face
> attribute instead.
>
Ok, thanks. I have actually already prepared patches for all these
features: full-color in ansi-color.el and term.el and also "basic" ANSI
escapes 1-8 for term.el that you mentioned.
I guess there's no harm in sending them right now.
>> 2) Two vector variables, that were recently added by Jim, were merged
>> into one. Adding him as CC.
>
> I see you posted an updated patch that doesn't merge these vectors. I
> don't have an opinion here, although if we do merge them, it would
> probably be nice to get that into Emacs 28; other packages might
> conceivably want to let-bind those[1].
Indeed, if we wanted to merge them we'd have to do it in Emacs 28.
That's why I think its best to simply leave them un-merged.
Thanks and best regards.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0002-Add-support-for-256-color-and-24bit-ANSI-colors-in-a.patch --]
[-- Type: text/x-patch, Size: 6750 bytes --]
From cc7c1a4888b6e4dfda3a370ce357d0029b6448cc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Sat, 2 Oct 2021 23:13:21 +0200
Subject: [PATCH 2/4] Add support for 256-color and 24bit ANSI colors in
ansi-color
* lisp/ansi-color.el (ansi-color--code-as-hex): New function to
convert from 256-color and 24-bit ANSI codes.
(ansi-color--face-vec-face): Add support for ANSI color codes greater
than 16
(ansi-color--update-face-vec): Add support for ANSI codes 38 and 48
which can specify 256-color and 24bit ANSI colors.
* test/lisp/ansi-color-tests.el (ansi-color-tests--strings): Add tests
for ANSI codes 38 and 34
---
etc/NEWS | 7 ++++
lisp/ansi-color.el | 70 ++++++++++++++++++++++++++++-------
test/lisp/ansi-color-tests.el | 12 +++++-
3 files changed, 74 insertions(+), 15 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 8c22230daf..e862b77563 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -65,6 +65,13 @@ binding in the menu.
** subr-x
*** New macro 'with-memoization' provides a very primitive form of memoization
+** ansi-color.el
+
+---
+*** Support for ANSI 256-color and 24-bit colors.
+256-color and 24-bit color codes are now handled by ANSI color
+filters and displayed with the specified color.
+
\f
* New Modes and Packages in Emacs 29.1
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 7b46754d83..8d394f353b 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -594,22 +594,24 @@ ansi-color--face-vec-face
(when-let ((fg (car colors)))
(push
`(:foreground
- ,(face-foreground
- (aref (if (or bright (>= fg 8))
- ansi-color-bright-colors-vector
- ansi-color-normal-colors-vector)
- (mod fg 8))
- nil 'default))
+ ,(or (ansi-color--code-as-hex fg)
+ (face-foreground
+ (aref (if (or bright (>= fg 8))
+ ansi-color-bright-colors-vector
+ ansi-color-normal-colors-vector)
+ (mod fg 8))
+ nil 'default)))
faces))
(when-let ((bg (cadr colors)))
(push
`(:background
- ,(face-background
- (aref (if (or bright (>= bg 8))
- ansi-color-bright-colors-vector
- ansi-color-normal-colors-vector)
- (mod bg 8))
- nil 'default))
+ ,(or (ansi-color--code-as-hex bg)
+ (face-background
+ (aref (if (or bright (>= bg 8))
+ ansi-color-bright-colors-vector
+ ansi-color-normal-colors-vector)
+ (mod bg 8))
+ nil 'default)))
faces))
(let ((i 8))
@@ -622,6 +624,32 @@ ansi-color--face-vec-face
faces
(car faces))))
+(defun ansi-color--code-as-hex (color)
+ "Convert COLOR to hexadecimal string representation.
+COLOR is an ANSI color code. If it is between 16 and 255
+inclusive, it corresponds to a color from an 8-bit color cube.
+If it is greater or equal than 256, it is subtracted by 256 to
+directly specify a 24-bit color.
+
+Return a hexadecimal string, specifying the color, or nil, if
+COLOR is less than 16."
+ (cond
+ ((< color 16) nil)
+ ((>= color 256) (format "#%06X" (- color 256)))
+ ((>= color 232) ;; Grayscale
+ (format "#%06X" (* #x010101 (+ 8 (* 10 (- color 232))))))
+ (t ;; 6x6x6 color cube
+ (setq color (- color 16))
+ (let ((res 0)
+ (frac (* 6 6)))
+ (while (<= 1 frac) ; Repeat 3 times
+ (setq res (* res #x000100))
+ (let ((color-num (mod (/ color frac) 6)))
+ (unless (zerop color-num)
+ (setq res (+ res #x37 (* #x28 color-num)))))
+ (setq frac (/ frac 6)))
+ (format "#%06X" res)))))
+
;; Working with regions
(defvar-local ansi-color-context-region nil
@@ -907,7 +935,23 @@ ansi-color--update-face-vec
(let ((r (mod new 10))
(cell (if (memq q '(3 9)) colors (cdr colors))))
(pcase r
- (8 (setq do-clear t))
+ (8
+ (pcase (funcall iterator)
+ (5 (setq new (setcar cell (funcall iterator)))
+ (setq do-clear (or (null new) (>= new 256))))
+ (2
+ (let ((red (funcall iterator))
+ (green (funcall iterator))
+ (blue (funcall iterator)))
+ (if (and red green blue
+ (progn
+ (setq new (+ (* #x010000 red)
+ (* #x000100 green)
+ (* #x000001 blue)))
+ (<= new #xFFFFFF)))
+ (setcar cell (+ 256 new))
+ (setq do-clear t))))
+ (_ (setq do-clear t))))
(9 (setcar cell nil))
(_ (setcar cell (+ (if (memq q '(3 4)) 0 8) r))))))
(_ (setq do-clear t)))
diff --git a/test/lisp/ansi-color-tests.el b/test/lisp/ansi-color-tests.el
index 953fdff893..16a1ba4a89 100644
--- a/test/lisp/ansi-color-tests.el
+++ b/test/lisp/ansi-color-tests.el
@@ -27,7 +27,8 @@
(defvar ansi-color-tests--strings
(let ((bright-yellow (face-foreground 'ansi-color-bright-yellow nil 'default))
- (yellow (face-foreground 'ansi-color-yellow nil 'default)))
+ (yellow (face-foreground 'ansi-color-yellow nil 'default))
+ (custom-color "#87FFFF"))
`(("Hello World" "Hello World")
("\e[33mHello World\e[0m" "Hello World"
(:foreground ,yellow))
@@ -51,7 +52,14 @@ ansi-color-tests--strings
(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"))))
+ ("\e[10munrecognized\e[0m" "unrecognized")
+ ("\e[38;5;3;1mHello World\e[0m" "Hello World"
+ (ansi-color-bold (:foreground ,yellow))
+ (ansi-color-bold (:foreground ,bright-yellow)))
+ ("\e[48;5;123;1mHello World\e[0m" "Hello World"
+ (ansi-color-bold (:background ,custom-color)))
+ ("\e[48;2;135;255;255;1mHello World\e[0m" "Hello World"
+ (ansi-color-bold (:background ,custom-color))))))
(ert-deftest ansi-color-apply-on-region-test ()
(pcase-dolist (`(,input ,text ,face) ansi-color-tests--strings)
--
2.33.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.3: 0003-Add-support-for-256-color-and-24bit-ANSI-colors-in-t.patch --]
[-- Type: text/x-patch, Size: 18727 bytes --]
From ad667c79926f28c5e82654c9f99dc23f41e9375e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Sat, 25 Sep 2021 23:28:08 +0200
Subject: [PATCH 3/4] Add support for 256-color and 24bit ANSI colors in
term-mode
(term-ansi-face-already-done): Make obsolete
(term--maybe-brighten-color): Remove
(term--color-as-hex): New function
(term-handle-colors-array): Make obsolete in favour of the new
function 'term--handle-colors-list'.
(term--handle-colors-list): New function, that can also handle ANSI
codes 38 and 48.
(term-handle-ansi-escape): Use it
* test/lisp/term-tests.el (ansi-test-strings): Add tests for 256-color
and 24bit ANSI colors
---
etc/NEWS | 7 ++
etc/e/README | 18 +--
etc/e/eterm-color | Bin 1179 -> 1275 bytes
etc/e/eterm-color.ti | 15 ++-
etc/e/eterm-direct | Bin 0 -> 1354 bytes
lisp/term.el | 249 +++++++++++++++++++---------------------
test/lisp/term-tests.el | 16 ++-
7 files changed, 163 insertions(+), 142 deletions(-)
create mode 100644 etc/e/eterm-direct
diff --git a/etc/NEWS b/etc/NEWS
index e862b77563..e22eac5e75 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -72,6 +72,13 @@ binding in the menu.
256-color and 24-bit color codes are now handled by ANSI color
filters and displayed with the specified color.
+** term-mode
+
+---
+*** Support for ANSI 256-color and 24-bit colors.
+256-color and 24-bit color codes are now displayed with the specified
+color.
+
\f
* New Modes and Packages in Emacs 29.1
diff --git a/etc/e/README b/etc/e/README
index dd2c8d64e2..1293292a87 100644
--- a/etc/e/README
+++ b/etc/e/README
@@ -1,12 +1,12 @@
-eterm-color.ti is a terminfo source file. eterm-color is a compiled
-version produced by the terminfo compiler (tic). The compiled files
-are binary, and depend on the version of tic, but they seem to be
-system-independent and backwardly compatible. So there should be no
-need to recompile the distributed binary version. If it is
-necessary, use:
+eterm-color.ti is a terminfo source file. eterm-color and
+eterm-direct are compiled versions produced by the terminfo compiler
+(tic). The compiled files are binary, and depend on the version of
+tic, but they seem to be system-independent and backwardly compatible.
+So there should be no need to recompile the distributed binary
+version. If it is necessary, use:
tic -o ../ ./eterm-color.ti
-The compiled file is used by lisp/term.el, so if it is moved term.el
-needs to be changed. terminfo requires it to be stored in an 'e'
-subdirectory (the first character of the file name).
+The compiled files are used by lisp/term.el, so if they are moved,
+term.el needs to be changed. terminfo requires them to be stored in
+an 'e' subdirectory (the first character of the file name).
diff --git a/etc/e/eterm-color b/etc/e/eterm-color
index bd3f5003ae620db49b89a2c1387b0ba1c836f4f1..99603ba5613b822d9916df63b7c1fcc6833a038d 100644
GIT binary patch
delta 160
zcmbQu`J0nliqV~c9|$uUS5D+EWMN?ZU%#>80uy8A=0IjW#u|Io0z=hmi&|A1)e>V6
tJ4H1WEM#Z~7PExO>w;vAEv!wgA*!r%8Kk3Ck+qv((QasfqTd8XKLBEMDcJx3
delta 64
zcmey(Ih&JPiqV~c9|$uUJtuM(vT!gsFl=nNz{F^^IgnY8QKrC9wc6OAR#jUyC6_@u
MS{2Aw*HDLW0nn2UQ~&?~
diff --git a/etc/e/eterm-color.ti b/etc/e/eterm-color.ti
index a6ef814990..61c29e6dcc 100644
--- a/etc/e/eterm-color.ti
+++ b/etc/e/eterm-color.ti
@@ -9,10 +9,10 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96,
# Any change to this file should be done at the same time with a
# corresponding change to the TERMCAP environment variable in term.el.
# Comments in term.el specify where each of these capabilities is implemented.
- colors#8,
+ colors#256,
cols#80,
lines#24,
- pairs#64,
+ pairs#32767,
am,
mir,
msgr,
@@ -65,8 +65,8 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96,
rmul=\E[24m,
rs1=\Ec,
sc=\E7,
- setab=\E[%p1%{40}%+%dm,
- setaf=\E[%p1%{30}%+%dm,
+ setab=\E[%?%p1%{8}%<%t4%p1%d%e%p1%{16}%<%t10%p1%{8}%-%d%e48;5;%p1%d%;m,
+ setaf=\E[%?%p1%{8}%<%t3%p1%d%e%p1%{16}%<%t9%p1%{8}%-%d%e38;5;%p1%d%;m,
sgr0=\E[m,
smir=\E[4h,
smul=\E[4m,
@@ -76,3 +76,10 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96,
# smcup=\E[?47h,
# rmcup=\E[?47l,
# rs2 may need to be added
+
+eterm-direct|Emacs term.el with direct-color indexing term-protocol-version 0.96,
+ use=eterm-color,
+ colors#0x1000000,
+ pairs#0x10000,
+ setab=\E[%?%p1%{8}%<%t4%p1%d%e48;2;%p1%{65536}%/%d;%p1%{256}%/%{255}%&%d;%p1%{255}%&%d%;m,
+ setaf=\E[%?%p1%{8}%<%t3%p1%d%e38;2;%p1%{65536}%/%d;%p1%{256}%/%{255}%&%d;%p1%{255}%&%d%;m,
diff --git a/etc/e/eterm-direct b/etc/e/eterm-direct
new file mode 100644
index 0000000000000000000000000000000000000000..35983ec8aded7b0c6b818df47abe57b9440934cb
GIT binary patch
literal 1354
zcmcgoJ!lkB5T18LqCpW0LD(QG_$&e!z5Tm8HbJ8aM9q<y#^P+k?P?b9Zja4kLgJ}~
z*jU)uq_DBEu&}jFYZXXqYilb6!urkJo~H&hA>!MenQy-Nd-Kj0?$Bv`k=j;a8YZn`
z5G7$FeLT}zYOI*djE7BgHA<JwUZmKFn{i@B?I2u>+7Be9*h%6vMxgj8Oje?}ZC)9#
zdPGWolB3iDY=(0#w~YUGkSa~GjHp0Es6R`iWJ;fl<Wd>P7jF`J3Nk}C#plko94*pa
zpnJ4L_l0>VI;ND?^Nhhgo`HFuvoBy@?#meDX4xxxjrb<y4ZWpzdG7l^*7WK>&_~*$
zPsrS%&-4ZM>u*)xa(@?g5ARS=y~<;`{rMgT#luIaJ?M=8n|Jb%8=X<3QgPvsb^mg!
zG1XPWbc&3+j&!G_17CM69V8%TjruK^+Yq+D#Aj)QGw3+<4agK^0aAmMT2Rh1RE1Ib
zhjJK6unAyEz!Gwfo`SKTkTHK9paf92*qa9M*mK##q<Nks7v*sRYJI?^!d&Zvxjx`N
z65`7WK%WK~6*9`aN{vn+;P9jpFN|gJ62T&%*M_pIzEkC^>#JP7QR(Ulo!Zh#hjzuc
keBnLUwY{#sEboXs%M}mS?dnSdw&!VoUrQ%%=^UZucQ(5!9smFU
literal 0
HcmV?d00001
diff --git a/lisp/term.el b/lisp/term.el
index e76eb77647..771b73238f 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -303,6 +303,7 @@ term-protocol-version
(require 'ange-ftp)
(require 'cl-lib))
(require 'comint) ; Password regexp.
+(require 'ansi-color)
(require 'ehelp)
(require 'ring)
(require 'shell)
@@ -717,6 +718,9 @@ term-ansi-current-underline
(defvar term-ansi-current-reverse nil)
(defvar term-ansi-current-invisible nil)
+(make-obsolete-variable 'term-ansi-face-already-done
+ "it doesn't have any effect." "28.1")
+
;;; Faces
(defvar ansi-term-color-vector
[term
@@ -1039,10 +1043,6 @@ term-ansi-reset
(setq term-ansi-current-reverse nil)
(setq term-ansi-current-color 0)
(setq term-ansi-current-invisible nil)
- ;; Stefan thought this should be t, but could not remember why.
- ;; Setting it to t seems to cause bug#11785. Setting it to nil
- ;; again to see if there are other consequences...
- (setq term-ansi-face-already-done nil)
(setq term-ansi-current-bg-color 0))
(define-derived-mode term-mode fundamental-mode "Term"
@@ -1584,7 +1584,8 @@ term-termcap-format
:so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\
:UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC\
:kl=\\EOD:kd=\\EOB:kr=\\EOC:ku=\\EOA:kN=\\E[6~:kP=\\E[5~:@7=\\E[4~:kh=\\E[1~\
-:mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#8:pa#64:AB=\\E[4%%dm:AF=\\E[3%%dm:cr=^M\
+:mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#256:pa#32767\
+:AB=\\E[48;5;%%dm:AF=\\E[38;5;%%dm:cr=^M\
:bl=^G:do=^J:le=^H:ta=^I:se=\\E[27m:ue=\\E[24m\
:kb=^?:kD=^[[3~:sc=\\E7:rc=\\E8:r1=\\Ec:"
;; : -undefine ic
@@ -3285,133 +3286,125 @@ term-reset-terminal
(setq term-current-row 0)
(setq term-current-column 1)
(term--reset-scroll-region)
- (setq term-insert-mode nil)
- ;; 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))
+ (setq term-insert-mode nil))
+
+(defun term--color-as-hex (for-foreground)
+ "Return the current ANSI color as a hexadecimal color string.
+Use the current background color if FOR-FOREGROUND is nil,
+otherwise use the current foreground color."
+ (let ((color (if for-foreground term-ansi-current-color
+ term-ansi-current-bg-color)))
+ (or (ansi-color--code-as-hex (1- color))
+ (progn
+ (and ansi-color-bold-is-bright term-ansi-current-bold
+ (<= 1 color 8)
+ (setq color (+ color 8)))
+ (if for-foreground
+ (face-foreground (elt ansi-term-color-vector color)
+ nil 'default)
+ (face-background (elt ansi-term-color-vector color)
+ nil 'default))))))
;; New function to deal with ansi colorized output, as you can see you can
;; have any bold/underline/fg/bg/reverse combination. -mm
(defun term-handle-colors-array (parameter)
- (cond
-
- ;; Bold (terminfo: bold)
- ((eq parameter 1)
- (setq term-ansi-current-bold t))
-
- ;; Underline
- ((eq parameter 4)
- (setq term-ansi-current-underline t))
-
- ;; Blink (unsupported by Emacs), will be translated to bold.
- ;; This may change in the future though.
- ((eq parameter 5)
- (setq term-ansi-current-bold t))
-
- ;; Reverse (terminfo: smso)
- ((eq parameter 7)
- (setq term-ansi-current-reverse t))
-
- ;; Invisible
- ((eq parameter 8)
- (setq term-ansi-current-invisible t))
-
- ;; Reset underline (terminfo: rmul)
- ((eq parameter 24)
- (setq term-ansi-current-underline nil))
-
- ;; Reset reverse (terminfo: rmso)
- ((eq parameter 27)
- (setq term-ansi-current-reverse nil))
-
- ;; Foreground
- ((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))
-
- ;; Background
- ((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))
-
- ;; 0 (Reset) or unknown (reset anyway)
- (t
- (term-ansi-reset)))
-
- ;; (message "Debug: U-%d R-%d B-%d I-%d D-%d F-%d B-%d"
- ;; term-ansi-current-underline
- ;; term-ansi-current-reverse
- ;; term-ansi-current-bold
- ;; term-ansi-current-invisible
- ;; term-ansi-face-already-done
- ;; term-ansi-current-color
- ;; term-ansi-current-bg-color)
-
- (unless term-ansi-face-already-done
- (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
- (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))))))
-
- ;; (message "Debug %S" term-current-face)
- ;; FIXME: shouldn't we set term-ansi-face-already-done to t here? --Stef
- (setq term-ansi-face-already-done nil))
+ (declare (obsolete term--handle-colors-list "28.1"))
+ (term--handle-colors-list (list parameter)))
+
+(defun term--handle-colors-list (parameters)
+ (while parameters
+ (pcase (pop parameters)
+ (1 (setq term-ansi-current-bold t)) ; (terminfo: bold)
+ (4 (setq term-ansi-current-underline t)) ; (terminfo: smul)
+ (5 (setq term-ansi-current-bold t)) ; (terminfo: bold)
+ (7 (setq term-ansi-current-reverse t)) ; (terminfo: smso, rev)
+ (8 (setq term-ansi-current-invisible t)) ; (terminfo: invis)
+ (24 (setq term-ansi-current-underline nil)) ; (terminfo: rmul)
+ (27 (setq term-ansi-current-reverse nil)) ; (terminfo: rmso)
+
+ ;; Foreground (terminfo: setaf)
+ ((and param (guard (<= 30 param 37)))
+ (setq term-ansi-current-color (- param 29)))
+
+ ;; Bright foreground (terminfo: setaf)
+ ((and param (guard (<= 90 param 97)))
+ (setq term-ansi-current-color (- param 81)))
+
+ ;; Extended foreground (terminfo: setaf)
+ (38
+ (pcase (pop parameters)
+ ;; 256 color
+ (5 (if (setq term-ansi-current-color (pop parameters))
+ (cl-incf term-ansi-current-color)
+ (term-ansi-reset)))
+ ;; Full 24-bit color
+ (2 (cl-loop with color = (1+ 256) ; Base
+ for i from 16 downto 0 by 8
+ if (pop parameters)
+ do (setq color (+ color (ash it i)))
+ else return (term-ansi-reset)
+ finally
+ (if (> color (+ 1 256 #xFFFFFF))
+ (term-ansi-reset)
+ (setq term-ansi-current-color color))))
+ (_ (term-ansi-reset))))
+
+ ;; Reset foreground (terminfo: op)
+ (39 (setq term-ansi-current-color 0))
+
+ ;; Background (terminfo: setab)
+ ((and param (guard (<= 40 param 47)))
+ (setq term-ansi-current-bg-color (- param 39)))
+
+ ;; Bright background (terminfo: setab)
+ ((and param (guard (<= 100 param 107)))
+ (setq term-ansi-current-bg-color (- param 91)))
+
+ ;; Extended background (terminfo: setab)
+ (48
+ (pcase (pop parameters)
+ ;; 256 color
+ (5 (if (setq term-ansi-current-bg-color (pop parameters))
+ (cl-incf term-ansi-current-bg-color)
+ (term-ansi-reset)))
+ ;; Full 24-bit color
+ (2 (cl-loop with color = (1+ 256) ; Base
+ for i from 16 downto 0 by 8
+ if (pop parameters)
+ do (setq color (+ color (ash it i)))
+ else return (term-ansi-reset)
+ finally
+ (if (> color (+ 1 256 #xFFFFFF))
+ (term-ansi-reset)
+ (setq term-ansi-current-bg-color color))))
+ (_ (term-ansi-reset))))
+
+ ;; Reset background (terminfo: op)
+ (49 (setq term-ansi-current-bg-color 0))
+
+ ;; 0 (Reset) (terminfo: sgr0) or unknown (reset anyway)
+ (_ (term-ansi-reset))))
+
+ (let (fg bg)
+ (if term-ansi-current-invisible
+ (setq bg (term--color-as-hex term-ansi-current-reverse)
+ fg bg)
+ (setq fg (term--color-as-hex t)
+ bg (term--color-as-hex nil)))
+ (setq term-current-face
+ `( :foreground ,fg
+ :background ,bg
+ ,@(unless term-ansi-current-invisible
+ (list :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))))
;; Handle a character assuming (eq terminal-state 2) -
@@ -3499,7 +3492,7 @@ term-handle-ansi-escape
;; \E[m - Set/reset modes, set bg/fg
;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf)
((eq char ?m)
- (mapc #'term-handle-colors-array params))
+ (term--handle-colors-list params))
;; \E[6n - Report cursor position (terminfo: u7)
((eq char ?n)
diff --git a/test/lisp/term-tests.el b/test/lisp/term-tests.el
index 96b6d73488..b8adc62c9d 100644
--- a/test/lisp/term-tests.el
+++ b/test/lisp/term-tests.el
@@ -42,6 +42,9 @@ bright-yellow-bg-props
`( :foreground "unspecified-fg"
:background ,(face-background 'term-color-bright-yellow nil 'default)
:inverse-video nil))
+(defvar custom-color-fg-props
+ `( :foreground "#87FFFF"
+ :background "unspecified-bg" :inverse-video nil))
(defvar ansi-test-strings
`(("\e[33mHello World\e[0m"
@@ -71,7 +74,18 @@ ansi-test-strings
,(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)))))
+ `(,bright-yellow-fg-props :inherit term-bold)))
+ ("\e[38;5;3;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[38;5;123;1mHello World\e[0m"
+ ,(propertize "Hello World" 'font-lock-face
+ `(,custom-color-fg-props :inherit term-bold)))
+ ("\e[38;2;135;255;255;1mHello World\e[0m"
+ ,(propertize "Hello World" 'font-lock-face
+ `(,custom-color-fg-props :inherit term-bold)))))
(defun term-test-screen-from-input (width height input &optional return-var)
(with-temp-buffer
--
2.33.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.4: 0004-In-term-mode-handle-ANSI-codes-specifying-italic-and.patch --]
[-- Type: text/x-patch, Size: 15659 bytes --]
From d1b256c98b658231cc4bbec83c7e3c2a44601dc3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Mon, 27 Sep 2021 15:15:57 +0200
Subject: [PATCH 4/4] In term-mode, handle ANSI codes, specifying italic and
other modes
* etc/e/eterm-color.ti: Add new capabilities
* lisp/term.el: New faces and variables to support new ANSI modes.
(term-termcap-format): Add new capabilities
(term-emulate-terminal): When saving cursor, additionally save the new
variables.
(term--handle-colors-list): Handle ANSI codes, specifying italic other
modes.
* test/lisp/term-tests.el (ansi-test-strings): Adjust tests.
---
etc/NEWS | 8 +--
etc/e/eterm-color | Bin 1275 -> 1296 bytes
etc/e/eterm-color.ti | 4 ++
etc/e/eterm-direct | Bin 1354 -> 1375 bytes
lisp/term.el | 105 ++++++++++++++++++++++++++++++----------
test/lisp/term-tests.el | 32 ++++++------
6 files changed, 104 insertions(+), 45 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index e22eac5e75..4b6a25c1e7 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -75,9 +75,11 @@ filters and displayed with the specified color.
** term-mode
---
-*** Support for ANSI 256-color and 24-bit colors.
-256-color and 24-bit color codes are now displayed with the specified
-color.
+*** Support for ANSI 256-color and 24-bit colors, italic and other fonts.
+Term-mode can now display 256-color and 24-bit color codes. It can
+also handle ANSI codes for faint, italic and blinking text, displaying
+it with new 'ansi-term-faint/italic/slow-blinking/fast-blinking'
+faces.
\f
* New Modes and Packages in Emacs 29.1
diff --git a/etc/e/eterm-color b/etc/e/eterm-color
index 99603ba5613b822d9916df63b7c1fcc6833a038d..bf44fa0f36de0f6681fa3172db13a83c414aa42a 100644
GIT binary patch
delta 286
zcmey(If08?iqV~c9|$uU_f6zp>EX)|#PA;o!Wm*15`nBVhHQocut+JGtYoNTXaTc8
zs$ifCDAETNodBe#GE6pPl#!UpFb~LC48+SB)-Y^@D%i>}c_O2d%}$0x45t~c00r+d
zJY#qdq<=saz)WRigs@nEG&>^~BM+3%&p7!aqZN}Nh&nl0fRUX^j1g$09+xzu8d!-o
zBhY#&F%zhIn0X-D5~RtC*`Bd(av*a6w`neebhIIeFq*uG`3}1=m}xw@ilq?%rk#|p
delta 241
zcmbQh^_!DhiqV~c9|$uUS5D+!>GA)+FT;N@2x15avSJt#8PdQa*<doCp@g9dssf@8
zL^c3LTA-qBK)Rb@vLU04L_fn6AZI2J&t+J|upFvjHN)hIj7m1^8FnxnWH<#Byv%Ti
z;VF=Q2UP$w_dAsT3rPQEU|?iogvhWmPQJ)!#l#MxPEHnJWM|@G1RANwCCDfPR-y=!
Ysbbb*%$yv^9KdKec@6WO$&*=X0X>z1egFUf
diff --git a/etc/e/eterm-color.ti b/etc/e/eterm-color.ti
index 61c29e6dcc..eeb9b0b6e6 100644
--- a/etc/e/eterm-color.ti
+++ b/etc/e/eterm-color.ti
@@ -18,6 +18,7 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96,
msgr,
xenl,
bel=^G,
+ blink=\E[5m,
bold=\E[1m,
clear=\E[H\E[J,
cr=\r,
@@ -31,6 +32,7 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96,
cup=\E[%i%p1%d;%p2%dH,
cuu1=\E[A,
cuu=\E[%p1%dA,
+ dim=\E[2m,
dch1=\E[P,
dch=\E[%p1%dP,
dl1=\E[M,
@@ -60,6 +62,7 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96,
rc=\E8,
rev=\E[7m,
ri=\EM,
+ ritm=\E[23m,
rmir=\E[4l,
rmso=\E[27m,
rmul=\E[24m,
@@ -68,6 +71,7 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96,
setab=\E[%?%p1%{8}%<%t4%p1%d%e%p1%{16}%<%t10%p1%{8}%-%d%e48;5;%p1%d%;m,
setaf=\E[%?%p1%{8}%<%t3%p1%d%e%p1%{16}%<%t9%p1%{8}%-%d%e38;5;%p1%d%;m,
sgr0=\E[m,
+ sitm=\E[3m,
smir=\E[4h,
smul=\E[4m,
smso=\E[7m,
diff --git a/etc/e/eterm-direct b/etc/e/eterm-direct
index 35983ec8aded7b0c6b818df47abe57b9440934cb..c113c3713693b948ae9d52e75df5d89957fd0c77 100644
GIT binary patch
delta 262
zcmX@bb)Sn{jwz6V9|$uUpHAey=;6x{#PA;o!Wm*15`nBVhHQocut+JGtYoNTXaTc8
zs$ifCDAETNodBe#GE8igk(kLa56E5&#LF4hFl>a%Z)KQ#kWtBcC&M9z(+pRDf_E97
zF}w%TKcEU=hB7ijSS&!Aoso-?2g>K4{E^X`Q4mO8WE2CE`kc~?YG65SAWxdn1V{=q
oS^`OLW_!j-lPj46xJ`2zq@xW%gwf<v%y-z0!A#@Hi&$0w0G2X_$p8QV
delta 232
zcmcc5b&88yjwz6V9|$uUFHGdV=<)x*FT;N@2x15avSJt#8PdQa*<doCp@g9dssf@8
zL^c3LTA-qBK)Rb@Vxx>iKf@FtdnORiWmv?p94fz>Ve&ynCF}JJI~Wc!oB|47X1K%f
z6iB~=Du5aL9m@X&r2jH7FfuVhWLPJEWVB{v2a*>Vd4Qxory!#YSWXeht7g_>tesrR
R9KdKe`3m!$$-7yW000mDghK!T
diff --git a/lisp/term.el b/lisp/term.el
index 771b73238f..ce086c379b 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -711,10 +711,14 @@ term-ansi-at-save-user
(defvar term-ansi-at-save-pwd nil)
(defvar term-ansi-at-save-anon nil)
(defvar term-ansi-current-bold nil)
+(defvar term-ansi-current-faint nil)
+(defvar term-ansi-current-italic nil)
+(defvar term-ansi-current-underline nil)
+(defvar term-ansi-current-slow-blink nil)
+(defvar term-ansi-current-fast-blink nil)
(defvar term-ansi-current-color 0)
(defvar term-ansi-face-already-done nil)
(defvar term-ansi-current-bg-color 0)
-(defvar term-ansi-current-underline nil)
(defvar term-ansi-current-reverse nil)
(defvar term-ansi-current-invisible nil)
@@ -769,12 +773,36 @@ term-bold
:group 'term
:version "28.1")
+(defface term-faint
+ '((t :inherit ansi-color-faint))
+ "Default face to use for faint text."
+ :group 'term
+ :version "28.1")
+
+(defface term-italic
+ '((t :inherit ansi-color-italic))
+ "Default face to use for italic text."
+ :group 'term
+ :version "28.1")
+
(defface term-underline
'((t :inherit ansi-color-underline))
"Default face to use for underlined text."
:group 'term
:version "28.1")
+(defface term-slow-blink
+ '((t :inherit ansi-color-slow-blink))
+ "Default face to use for slowly blinking text."
+ :group 'term
+ :version "28.1")
+
+(defface term-fast-blink
+ '((t :inherit ansi-color-fast-blink))
+ "Default face to use for rapidly blinking text."
+ :group 'term
+ :version "28.1")
+
(defface term-color-black
'((t :inherit ansi-color-black))
"Face used to render black color code."
@@ -1038,8 +1066,12 @@ term-display-table
(defun term-ansi-reset ()
(setq term-current-face 'term)
- (setq term-ansi-current-underline nil)
(setq term-ansi-current-bold nil)
+ (setq term-ansi-current-faint nil)
+ (setq term-ansi-current-italic nil)
+ (setq term-ansi-current-underline nil)
+ (setq term-ansi-current-slow-blink nil)
+ (setq term-ansi-current-fast-blink nil)
(setq term-ansi-current-reverse nil)
(setq term-ansi-current-color 0)
(setq term-ansi-current-invisible nil)
@@ -1581,6 +1613,7 @@ term-termcap-format
:nd=\\E[C:up=\\E[A:ce=\\E[K:ho=\\E[H:pt\
:al=\\E[L:dl=\\E[M:DL=\\E[%%dM:AL=\\E[%%dL:cs=\\E[%%i%%d;%%dr:sf=^J\
:dc=\\E[P:DC=\\E[%%dP:IC=\\E[%%d@:im=\\E[4h:ei=\\E[4l:mi:\
+:mb=\\E[5m:mh=\\E[2m:ZR=\\E[23m:ZH=\\E[3m\
:so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\
:UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC\
:kl=\\EOD:kd=\\EOB:kr=\\EOC:ku=\\EOA:kN=\\E[6~:kP=\\E[5~:@7=\\E[4~:kh=\\E[1~\
@@ -3105,30 +3138,34 @@ term-emulate-terminal
(term-horizontal-column)
term-ansi-current-bg-color
term-ansi-current-bold
+ term-ansi-current-faint
+ term-ansi-current-italic
+ term-ansi-current-underline
+ term-ansi-current-slow-blink
+ term-ansi-current-fast-blink
term-ansi-current-color
term-ansi-current-invisible
term-ansi-current-reverse
- term-ansi-current-underline
term-current-face)))
(?8 ;; Restore cursor (terminfo: rc, [ctlseqs]
;; "DECRC").
(when term-saved-cursor
(term-goto (nth 0 term-saved-cursor)
(nth 1 term-saved-cursor))
- (setq term-ansi-current-bg-color
- (nth 2 term-saved-cursor)
- term-ansi-current-bold
- (nth 3 term-saved-cursor)
- term-ansi-current-color
- (nth 4 term-saved-cursor)
- term-ansi-current-invisible
- (nth 5 term-saved-cursor)
- term-ansi-current-reverse
- (nth 6 term-saved-cursor)
- term-ansi-current-underline
- (nth 7 term-saved-cursor)
- term-current-face
- (nth 8 term-saved-cursor))))
+ (pcase-setq
+ `( ,_ ,_
+ ,term-ansi-current-bg-color
+ ,term-ansi-current-bold
+ ,term-ansi-current-faint
+ ,term-ansi-current-italic
+ ,term-ansi-current-underline
+ ,term-ansi-current-slow-blink
+ ,term-ansi-current-fast-blink
+ ,term-ansi-current-color
+ ,term-ansi-current-invisible
+ ,term-ansi-current-reverse
+ ,term-current-face)
+ term-saved-cursor)))
(?c ;; \Ec - Reset (terminfo: rs1, [ctlseqs] "RIS").
;; This is used by the "clear" program.
(term-reset-terminal))
@@ -3316,11 +3353,20 @@ term--handle-colors-list
(while parameters
(pcase (pop parameters)
(1 (setq term-ansi-current-bold t)) ; (terminfo: bold)
+ (2 (setq term-ansi-current-faint t)) ; (terminfo: dim)
+ (3 (setq term-ansi-current-italic t)) ; (terminfo: sitm)
(4 (setq term-ansi-current-underline t)) ; (terminfo: smul)
- (5 (setq term-ansi-current-bold t)) ; (terminfo: bold)
+ (5 (setq term-ansi-current-slow-blink t)) ; (terminfo: blink)
+ (6 (setq term-ansi-current-fast-blink t))
(7 (setq term-ansi-current-reverse t)) ; (terminfo: smso, rev)
(8 (setq term-ansi-current-invisible t)) ; (terminfo: invis)
+ (21 (setq term-ansi-current-bold nil))
+ (22 (setq term-ansi-current-bold nil)
+ (setq term-ansi-current-faint nil))
+ (23 (setq term-ansi-current-italic nil)) ; (terminfo: ritm)
(24 (setq term-ansi-current-underline nil)) ; (terminfo: rmul)
+ (25 (setq term-ansi-current-slow-blink nil)
+ (setq term-ansi-current-fast-blink nil))
(27 (setq term-ansi-current-reverse nil)) ; (terminfo: rmso)
;; Foreground (terminfo: setaf)
@@ -3398,13 +3444,20 @@ term--handle-colors-list
,@(unless term-ansi-current-invisible
(list :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))))
+ (setq term-current-face
+ `(,term-current-face
+ ,@(when term-ansi-current-bold
+ '(term-bold))
+ ,@(when term-ansi-current-faint
+ '(term-faint))
+ ,@(when term-ansi-current-italic
+ '(term-italic))
+ ,@(when term-ansi-current-underline
+ '(term-underline))
+ ,@(when term-ansi-current-slow-blink
+ '(term-slow-blink))
+ ,@(when term-ansi-current-fast-blink
+ '(term-fast-blink)))))
;; Handle a character assuming (eq terminal-state 2) -
@@ -3490,7 +3543,7 @@ term-handle-ansi-escape
;; Modified to allow ansi coloring -mm
;; \E[m - Set/reset modes, set bg/fg
- ;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf)
+ ;;(terminfo: smso,rmso,smul,rmul,rev,bold,dim,sitm,ritm,blink,sgr0,invis,op,setab,setaf)
((eq char ?m)
(term--handle-colors-list params))
diff --git a/test/lisp/term-tests.el b/test/lisp/term-tests.el
index b8adc62c9d..73d39cf3b6 100644
--- a/test/lisp/term-tests.el
+++ b/test/lisp/term-tests.el
@@ -48,44 +48,44 @@ custom-color-fg-props
(defvar ansi-test-strings
`(("\e[33mHello World\e[0m"
- ,(propertize "Hello World" 'font-lock-face yellow-fg-props))
+ ,(propertize "Hello World" 'font-lock-face `(,yellow-fg-props)))
("\e[43mHello World\e[0m"
- ,(propertize "Hello World" 'font-lock-face yellow-bg-props))
+ ,(propertize "Hello World" 'font-lock-face `(,yellow-bg-props)))
("\e[93mHello World\e[0m"
- ,(propertize "Hello World" 'font-lock-face bright-yellow-fg-props))
+ ,(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))
+ ,(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))
+ `(,yellow-fg-props term-bold))
,(propertize "Hello World" 'font-lock-face
- `(,bright-yellow-fg-props :inherit term-bold)))
+ `(,bright-yellow-fg-props term-bold)))
("\e[33;1mHello World\e[0m"
,(propertize "Hello World" 'font-lock-face
- `(,yellow-fg-props :inherit term-bold))
+ `(,yellow-fg-props term-bold))
,(propertize "Hello World" 'font-lock-face
- `(,bright-yellow-fg-props :inherit term-bold)))
+ `(,bright-yellow-fg-props term-bold)))
("\e[1m\e[33mHello World\e[0m"
,(propertize "Hello World" 'font-lock-face
- `(,yellow-fg-props :inherit term-bold))
+ `(,yellow-fg-props term-bold))
,(propertize "Hello World" 'font-lock-face
- `(,bright-yellow-fg-props :inherit term-bold)))
+ `(,bright-yellow-fg-props term-bold)))
("\e[33m\e[1mHello World\e[0m"
,(propertize "Hello World" 'font-lock-face
- `(,yellow-fg-props :inherit term-bold))
+ `(,yellow-fg-props term-bold))
,(propertize "Hello World" 'font-lock-face
- `(,bright-yellow-fg-props :inherit term-bold)))
+ `(,bright-yellow-fg-props term-bold)))
("\e[38;5;3;1mHello World\e[0m"
,(propertize "Hello World" 'font-lock-face
- `(,yellow-fg-props :inherit term-bold))
+ `(,yellow-fg-props term-bold))
,(propertize "Hello World" 'font-lock-face
- `(,bright-yellow-fg-props :inherit term-bold)))
+ `(,bright-yellow-fg-props term-bold)))
("\e[38;5;123;1mHello World\e[0m"
,(propertize "Hello World" 'font-lock-face
- `(,custom-color-fg-props :inherit term-bold)))
+ `(,custom-color-fg-props term-bold)))
("\e[38;2;135;255;255;1mHello World\e[0m"
,(propertize "Hello World" 'font-lock-face
- `(,custom-color-fg-props :inherit term-bold)))))
+ `(,custom-color-fg-props term-bold)))))
(defun term-test-screen-from-input (width height input &optional return-var)
(with-temp-buffer
--
2.33.0
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]
^ permalink raw reply related [flat|nested] 12+ messages in thread
* bug#50806: 27.2; [PATCH] Optimize ansi-color.el
2021-10-03 19:54 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-10-03 20:16 ` Jim Porter
2021-10-04 10:17 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 12+ messages in thread
From: Jim Porter @ 2021-10-03 20:16 UTC (permalink / raw)
To: miha, 50806; +Cc: Lars Ingebrigtsen
On 10/3/2021 12:54 PM, miha--- via Bug reports for GNU Emacs, the Swiss
army knife of text editors wrote:
> Ok, thanks. I have actually already prepared patches for all these
> features: full-color in ansi-color.el and term.el and also "basic" ANSI
> escapes 1-8 for term.el that you mentioned.
>
> I guess there's no harm in sending them right now.
I took a brief look at these and they seem reasonable to my eyes. It'll
be nice to have (mostly) complete support for reading ANSI colors in Emacs.
Thinking about it a bit more, one thing that might be nice to add for
the first patch would be some additional tests to be sure that
`ansi-color-context-region' and `ansi-color-context' work as expected
(i.e. testing that multiple calls to `ansi-color-apply-on-region' and
similar produce the correct results). That's one of the trickier bits in
ansi-color.el (to me, anyway), and it'd be good to be sure all the
various cases still work there. That said, it might be best to let the
maintainers take a look before spending too much time on further tests.
>> I see you posted an updated patch that doesn't merge these vectors. I
>> don't have an opinion here, although if we do merge them, it would
>> probably be nice to get that into Emacs 28; other packages might
>> conceivably want to let-bind those[1].
>
> Indeed, if we wanted to merge them we'd have to do it in Emacs 28.
> That's why I think its best to simply leave them un-merged.
If there's a performance benefit to merging them, I think it would be
nice to do so while we have the chance. Perhaps a patch that just merges
the two vectors, and nothing else, would make sense for Emacs 28. Best
to ask the maintainers in this case too, though.
^ permalink raw reply [flat|nested] 12+ messages in thread
* bug#50806: 27.2; [PATCH] Optimize ansi-color.el
2021-10-03 19:59 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-10-04 9:27 ` Lars Ingebrigtsen
2021-10-04 10:07 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 12+ messages in thread
From: Lars Ingebrigtsen @ 2021-10-04 9:27 UTC (permalink / raw)
To: miha; +Cc: Jim Porter, 50806
<miha@kamnitnik.top> writes:
> Ok, thanks. I have actually already prepared patches for all these
> features: full-color in ansi-color.el and term.el and also "basic" ANSI
> escapes 1-8 for term.el that you mentioned.
>
> I guess there's no harm in sending them right now.
We could apply both the patch to optimize ansi-color.el and add this new
stuff now (to the Emacs trunk, i.e., Emacs 29), but there was some
discussion about merging... er... something? That I didn't quite
understand? :-)
So just to clarify --
Subject: [PATCH] Optimize ansi-color.el
and
Subject: [PATCH 2/4] Add support for 256-color and 24bit ANSI colors in ansi-color
are independent patches, and they should both be applied to Emacs 29?
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 12+ messages in thread
* bug#50806: 27.2; [PATCH] Optimize ansi-color.el
2021-10-04 9:27 ` Lars Ingebrigtsen
@ 2021-10-04 10:07 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-05 6:56 ` Lars Ingebrigtsen
0 siblings, 1 reply; 12+ messages in thread
From: miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-10-04 10:07 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: Jim Porter, 50806
[-- Attachment #1: Type: text/plain, Size: 1801 bytes --]
Lars Ingebrigtsen <larsi@gnus.org> writes:
> <miha@kamnitnik.top> writes:
>
>> Ok, thanks. I have actually already prepared patches for all these
>> features: full-color in ansi-color.el and term.el and also "basic" ANSI
>> escapes 1-8 for term.el that you mentioned.
>>
>> I guess there's no harm in sending them right now.
>
> We could apply both the patch to optimize ansi-color.el and add this new
> stuff now (to the Emacs trunk, i.e., Emacs 29), but there was some
> discussion about merging... er... something? That I didn't quite
> understand? :-)
Yeah sorry for the confusion. We were talking about "merging" two vector
variables of length 8 into one vector variable of length 16,
specifically, replacing the two
'ansi-color-*-colors-vector' variables with one
'ansi-color-colors-vector'.
These two variables are public and introduced in Emacs 28. If we wanted
to merge them, we'd have to do it on the Emacs-28 branch. However, the
performance gain from having them merged is negligible, so I think there
will be less complications if we just leave them as they are. This means
that patching Emacs-28 isn't required and all my patches from my second
mail onward are meant for Emacs 29.
>
> So just to clarify --
>
> Subject: [PATCH] Optimize ansi-color.el
>
> and
>
> Subject: [PATCH 2/4] Add support for 256-color and 24bit ANSI colors in ansi-color
>
> are independent patches, and they should both be applied to Emacs 29?
Yes, [PATCH] Optimize ansi-color.el (from my second e-mail)
and [PATCH 2/4] Add support for 256-color and 24bit ANSI colors in ansi-color
are meant to be applied to Emacs 29 on top of each-other.
>
> --
> (domestic pets only, the antidote for overdose, milk.)
> bloggy blog: http://lars.ingebrigtsen.no
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]
^ permalink raw reply [flat|nested] 12+ messages in thread
* bug#50806: 27.2; [PATCH] Optimize ansi-color.el
2021-10-03 20:16 ` Jim Porter
@ 2021-10-04 10:17 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 0 replies; 12+ messages in thread
From: miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-10-04 10:17 UTC (permalink / raw)
To: Jim Porter, 50806; +Cc: Lars Ingebrigtsen
[-- Attachment #1: Type: text/plain, Size: 1700 bytes --]
Jim Porter <jporterbugs@gmail.com> writes:
> I took a brief look at these and they seem reasonable to my eyes. It'll
> be nice to have (mostly) complete support for reading ANSI colors in Emacs.
>
> Thinking about it a bit more, one thing that might be nice to add for
> the first patch would be some additional tests to be sure that
> `ansi-color-context-region' and `ansi-color-context' work as expected
> (i.e. testing that multiple calls to `ansi-color-apply-on-region' and
> similar produce the correct results). That's one of the trickier bits
> in ansi-color.el (to me, anyway), and it'd be good to be sure all the
> various cases still work there.
> [...]
>
Good idea. For testing my patches, I already made some private tests of
this nature (but only for ansi-color and not for term-mode). It should
be easy to polish them up for ansi-color-tests.el. Will probably send a
patch later.
>>> I see you posted an updated patch that doesn't merge these vectors. I
>>> don't have an opinion here, although if we do merge them, it would
>>> probably be nice to get that into Emacs 28; other packages might
>>> conceivably want to let-bind those[1].
>>
>> Indeed, if we wanted to merge them we'd have to do it in Emacs 28.
>> That's why I think its best to simply leave them un-merged.
>
> If there's a performance benefit to merging them, I think it would be
> nice to do so while we have the chance. Perhaps a patch that just merges
> the two vectors, and nothing else, would make sense for Emacs 28. Best
> to ask the maintainers in this case too, though.
The performance benefit I measured was negligible so I think it's fine
to just focus on Emacs 29.
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]
^ permalink raw reply [flat|nested] 12+ messages in thread
* bug#50806: 27.2; [PATCH] Optimize ansi-color.el
2021-10-04 10:07 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-10-05 6:56 ` Lars Ingebrigtsen
2021-10-05 11:18 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 12+ messages in thread
From: Lars Ingebrigtsen @ 2021-10-05 6:56 UTC (permalink / raw)
To: miha; +Cc: Jim Porter, 50806
<miha@kamnitnik.top> writes:
> Yes, [PATCH] Optimize ansi-color.el (from my second e-mail)
> and [PATCH 2/4] Add support for 256-color and 24bit ANSI colors in ansi-color
>
> are meant to be applied to Emacs 29 on top of each-other.
Thanks; I've now applied all the patches, I think, and pushed to the
trunk.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 12+ messages in thread
* bug#50806: 27.2; [PATCH] Optimize ansi-color.el
2021-10-05 6:56 ` Lars Ingebrigtsen
@ 2021-10-05 11:18 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-06 8:51 ` Lars Ingebrigtsen
0 siblings, 1 reply; 12+ messages in thread
From: miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-10-05 11:18 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: Jim Porter, 50806
[-- Attachment #1.1: Type: text/plain, Size: 534 bytes --]
Lars Ingebrigtsen <larsi@gnus.org> writes:
> <miha@kamnitnik.top> writes:
>
>> Yes, [PATCH] Optimize ansi-color.el (from my second e-mail)
>> and [PATCH 2/4] Add support for 256-color and 24bit ANSI colors in ansi-color
>>
>> are meant to be applied to Emacs 29 on top of each-other.
>
> Thanks; I've now applied all the patches, I think, and pushed to the
> trunk.
>
Thanks.
Here, I attach two more patches, one with minor documentation fixes and
one with a new test for incomplete ANSI escape sequences.
Thanks and best regards.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-Documentation-fixes-for-recent-ansi-color-additions.patch --]
[-- Type: text/x-patch, Size: 2041 bytes --]
From a5dcb656893330cfed57ccadc48bfa9c96321a55 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Tue, 5 Oct 2021 11:14:22 +0200
Subject: [PATCH 1/2] Documentation fixes for recent ansi-color additions
* lisp/ansi-color.el (ansi-color-context-region): Improve formatting.
* lisp/term.el
(term-ansi-face-already-done):
(term-handle-colors-array):
Fix obsoleting version (bug#50806).
---
lisp/ansi-color.el | 4 ++--
lisp/term.el | 4 ++--
2 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index aaaf60cd00..2e51264ec3 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -656,9 +656,9 @@ ansi-color-context-region
"Context saved between two calls to `ansi-color-apply-on-region'.
This is a list of the form (FACE-VEC MARKER) or nil. FACE-VEC
represents the state the last call to `ansi-color-apply-on-region'
-ended with, currently a list of the form
+ended with, currently a list of the form:
-(BASIC-FACES FG BG).
+ (BASIC-FACES FG BG).
BASIC-FACES is a bool-vector that specifies which basic faces
from `ansi-color-basic-faces-vector' to apply. FG and BG are
diff --git a/lisp/term.el b/lisp/term.el
index ce086c379b..0e36e877e6 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -723,7 +723,7 @@ term-ansi-current-reverse
(defvar term-ansi-current-invisible nil)
(make-obsolete-variable 'term-ansi-face-already-done
- "it doesn't have any effect." "28.1")
+ "it doesn't have any effect." "29.1")
;;; Faces
(defvar ansi-term-color-vector
@@ -3346,7 +3346,7 @@ term--color-as-hex
;; have any bold/underline/fg/bg/reverse combination. -mm
(defun term-handle-colors-array (parameter)
- (declare (obsolete term--handle-colors-list "28.1"))
+ (declare (obsolete term--handle-colors-list "29.1"))
(term--handle-colors-list (list parameter)))
(defun term--handle-colors-list (parameters)
--
2.33.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.3: 0002-Add-tests-for-incomplete-escape-sequences-in-ansi-co.patch --]
[-- Type: text/x-patch, Size: 4623 bytes --]
From c73b559cc705ef3f01eb04ad62947a59ed316657 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Tue, 5 Oct 2021 12:20:45 +0200
Subject: [PATCH 2/2] Add tests for incomplete escape sequences in
ansi-color-tests
* test/lisp/ansi-color-tests.el
(ansi-color-tests-equal-props): New function.
(ansi-color-incomplete-sequences-test): New ert test (bug#50806).
---
test/lisp/ansi-color-tests.el | 82 +++++++++++++++++++++++++++++++++++
1 file changed, 82 insertions(+)
diff --git a/test/lisp/ansi-color-tests.el b/test/lisp/ansi-color-tests.el
index 16a1ba4a89..14a14ca4f0 100644
--- a/test/lisp/ansi-color-tests.el
+++ b/test/lisp/ansi-color-tests.el
@@ -24,6 +24,7 @@
;;; Code:
(require 'ansi-color)
+(eval-when-compile (require 'cl-lib))
(defvar ansi-color-tests--strings
(let ((bright-yellow (face-foreground 'ansi-color-bright-yellow nil 'default))
@@ -61,6 +62,17 @@ ansi-color-tests--strings
("\e[48;2;135;255;255;1mHello World\e[0m" "Hello World"
(ansi-color-bold (:background ,custom-color))))))
+(defun ansi-color-tests-equal-props (o1 o2)
+ "Return t if two Lisp objects have similar structure and contents.
+While `equal-including-properties' compares text properties of
+strings with `eq', this function compares them with `equal'."
+ (or (equal-including-properties o1 o2)
+ (and (stringp o1)
+ (equal o1 o2)
+ (cl-loop for i below (length o1)
+ always (equal (text-properties-at i o1)
+ (text-properties-at i o2))))))
+
(ert-deftest ansi-color-apply-on-region-test ()
(pcase-dolist (`(,input ,text ,face) ansi-color-tests--strings)
(with-temp-buffer
@@ -91,6 +103,76 @@ ansi-color-apply-on-region-preserving-test
(ansi-color-apply-on-region (point-min) (point-max) t)
(should (equal (buffer-string) (car pair))))))
+(ert-deftest ansi-color-incomplete-sequences-test ()
+ (let* ((strs (list "\e[" "2;31m Hello World "
+ "\e" "[108;5;12" "3m" "Greetings"
+ "\e[0m\e[35;6m" "Hello"))
+ (complete-str (apply #'concat strs))
+ (filtered-str)
+ (propertized-str)
+ (ansi-color-apply-face-function
+ #'ansi-color-apply-text-property-face)
+ (ansi-filt (lambda (str) (ansi-color-filter-apply
+ (copy-sequence str))))
+ (ansi-app (lambda (str) (ansi-color-apply
+ (copy-sequence str)))))
+
+ (with-temp-buffer
+ (setq filtered-str
+ (replace-regexp-in-string "\e\\[.*?m" "" complete-str))
+ (setq propertized-str (funcall ansi-app complete-str))
+
+ (should-not (ansi-color-tests-equal-props
+ filtered-str propertized-str))
+ (should (equal filtered-str propertized-str)))
+
+ ;; Tests for `ansi-color-filter-apply'
+ (with-temp-buffer
+ (should (equal-including-properties
+ filtered-str
+ (funcall ansi-filt complete-str))))
+
+ (with-temp-buffer
+ (should (equal-including-properties
+ filtered-str
+ (mapconcat ansi-filt strs ""))))
+
+ ;; Tests for `ansi-color-filter-region'
+ (with-temp-buffer
+ (insert complete-str)
+ (ansi-color-filter-region (point-min) (point-max))
+ (should (equal-including-properties
+ filtered-str (buffer-string))))
+
+ (with-temp-buffer
+ (dolist (str strs)
+ (let ((opoint (point)))
+ (insert str)
+ (ansi-color-filter-region opoint (point))))
+ (should (equal-including-properties
+ filtered-str (buffer-string))))
+
+ ;; Test for `ansi-color-apply'
+ (with-temp-buffer
+ (should (ansi-color-tests-equal-props
+ propertized-str
+ (mapconcat ansi-app strs ""))))
+
+ ;; Tests for `ansi-color-apply-on-region'
+ (with-temp-buffer
+ (insert complete-str)
+ (ansi-color-apply-on-region (point-min) (point-max))
+ (should (ansi-color-tests-equal-props
+ propertized-str (buffer-string))))
+
+ (with-temp-buffer
+ (dolist (str strs)
+ (let ((opoint (point)))
+ (insert str)
+ (ansi-color-apply-on-region opoint (point))))
+ (should (ansi-color-tests-equal-props
+ propertized-str (buffer-string))))))
+
(provide 'ansi-color-tests)
;;; ansi-color-tests.el ends here
--
2.33.0
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]
^ permalink raw reply related [flat|nested] 12+ messages in thread
* bug#50806: 27.2; [PATCH] Optimize ansi-color.el
2021-10-05 11:18 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-10-06 8:51 ` Lars Ingebrigtsen
0 siblings, 0 replies; 12+ messages in thread
From: Lars Ingebrigtsen @ 2021-10-06 8:51 UTC (permalink / raw)
To: miha; +Cc: Jim Porter, 50806
<miha@kamnitnik.top> writes:
> Here, I attach two more patches, one with minor documentation fixes and
> one with a new test for incomplete ANSI escape sequences.
Thanks; applied to Emacs 29.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 12+ messages in thread
end of thread, other threads:[~2021-10-06 8:51 UTC | newest]
Thread overview: 12+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2021-09-25 22:32 bug#50806: 27.2; [PATCH] Optimize ansi-color.el miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-03 16:31 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-03 17:53 ` Jim Porter
2021-10-03 19:54 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-03 20:16 ` Jim Porter
2021-10-04 10:17 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-03 19:59 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-04 9:27 ` Lars Ingebrigtsen
2021-10-04 10:07 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-05 6:56 ` Lars Ingebrigtsen
2021-10-05 11:18 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-06 8:51 ` Lars Ingebrigtsen
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).