diff options
-rw-r--r-- | lisp/ansi-color.el | 24 | ||||
-rw-r--r-- | test/lisp/ansi-color-tests.el | 49 |
2 files changed, 66 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) diff --git a/test/lisp/ansi-color-tests.el b/test/lisp/ansi-color-tests.el new file mode 100644 index 00000000000..5c3da875f8c --- /dev/null +++ b/test/lisp/ansi-color-tests.el @@ -0,0 +1,49 @@ +;;; ansi-color-tests.el --- Test suite for ansi-color -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Pablo Barbáchano <pablob@amazon.com> +;; Keywords: ansi + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ansi-color) + +(defvar test-strings '(("\e[33mHello World\e[0m" . "Hello World") + ("\e[1m\e[3m\e[5mbold italics blink\e[0m" . "bold italics blink"))) + +(ert-deftest ansi-color-apply-on-region-test () + (dolist (pair test-strings) + (with-temp-buffer + (insert (car pair)) + (ansi-color-apply-on-region (point-min) (point-max)) + (should (equal (buffer-string) (cdr pair))) + (should (not (equal (overlays-at (point-min)) nil)))))) + +(ert-deftest ansi-color-apply-on-region-preserving-test () + (dolist (pair test-strings) + (with-temp-buffer + (insert (car pair)) + (ansi-color-apply-on-region (point-min) (point-max) t) + (should (equal (buffer-string) (car pair)))))) + +(provide 'ansi-color-tests) + +;;; ansi-color-tests.el ends here |