Add an option to preserve ANSI sequences

* lisp/ansi-color.el Add an option to preserve the ANSI sequences
* test/lisp/ansi-color-tests.el: Add tests (bug#44589).

1 files changed, 17 insertions, 7 deletions

diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index e9cdf03db08..d5432a60fba 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -363,7 +363,7 @@ it will override BEGIN, the start of the region.  Set
 	  (setq ansi-color-context-region (list nil (match-beginning 0)))
 	(setq ansi-color-context-region nil)))))
 
-(defun ansi-color-apply-on-region (begin end)
+(defun ansi-color-apply-on-region (begin end &optional preserve-sequences)
   "Translates SGR control sequences into overlays or extents.
 Delete all other control sequences without processing them.
 
@@ -380,18 +380,28 @@ ansi codes.  This information will be used for the next call to
 `ansi-color-apply-on-region'.  Specifically, it will override
 BEGIN, the start of the region and set the face with which to
 start.  Set `ansi-color-context-region' to nil if you don't want
-this."
+this.
+
+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)))
+        (start-marker (or (cadr ansi-color-context-region)
+                          (copy-marker begin)))
+        (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)
-        ;; Remove escape sequence.
-        (let ((esc-seq (delete-and-extract-region
+        ;; 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)))
+
           ;; Colorize the old block from start to end using old face.
           (funcall ansi-color-apply-face-function
                    (prog1 (marker-position start-marker)