[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/cider 398b370e8e 2/4: Workaround for `ansi-color-apply' Em
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/cider 398b370e8e 2/4: Workaround for `ansi-color-apply' Emacs bug#53808 (#3154) |
|
Date: |
Sat, 5 Mar 2022 02:57:55 -0500 (EST) |
branch: elpa/cider
commit 398b370e8e8a7f7750b08676a16d4cfbaad0a027
Author: ikappaki <34983288+ikappaki@users.noreply.github.com>
Commit: GitHub <noreply@github.com>
Workaround for `ansi-color-apply' Emacs bug#53808 (#3154)
Enabled only in Emacs versions < 29.
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=53808.
Also fixed a couple of old linter docstring warnings.
---
cider-mode.el | 2 +-
cider-repl-history.el | 2 +-
cider-repl.el | 59 ++++++++++++++++++++++++++++++------
test/cider-repl-tests.el | 79 ++++++++++++++++++++++++++++++++++++++++--------
4 files changed, 118 insertions(+), 24 deletions(-)
diff --git a/cider-mode.el b/cider-mode.el
index b8a12f1557..3897a612e6 100644
--- a/cider-mode.el
+++ b/cider-mode.el
@@ -765,7 +765,7 @@ with the given LIMIT."
value))
(defun cider--compile-font-lock-keywords (symbols-plist core-plist)
- "Return a list of font-lock rules for symbols."
+ "Return a list of font-lock rules for symbols in SYMBOLS-PLIST, CORE-PLIST."
(let ((cider-font-lock-dynamically (if (eq cider-font-lock-dynamically t)
'(function var macro core deprecated)
cider-font-lock-dynamically))
diff --git a/cider-repl-history.el b/cider-repl-history.el
index ff77613182..4a4c7c87c6 100644
--- a/cider-repl-history.el
+++ b/cider-repl-history.el
@@ -344,7 +344,7 @@ case return nil."
(error "No CIDER history item here")))))
(defun cider-repl-history-current-string (pt &optional no-error)
- "Find the string to insert into the REPL by looking for the overlay at PT
+ "Find the string to insert into the REPL by looking for the overlay at PT.
Might error unless NO-ERROR set."
(let ((o (cider-repl-history-target-overlay-at pt t)))
(if o
diff --git a/cider-repl.el b/cider-repl.el
index 674c0279dc..123e541723 100644
--- a/cider-repl.el
+++ b/cider-repl.el
@@ -593,13 +593,51 @@ Return the position of the prompt beginning."
(set-marker cider-repl-prompt-start-mark prompt-start)
prompt-start))))
-(defun cider-repl--flush-ansi-color-context ()
- "Flush ansi color context after printing.
-When there is a possible unfinished ansi control sequence,
- `ansi-color-context` maintains this list."
- (when (and ansi-color-context (stringp (cadr ansi-color-context)))
- (insert-before-markers (cadr ansi-color-context))
- (setq ansi-color-context nil)))
+(defun cider-repl--ansi-color-apply (string)
+ "Like `ansi-color-apply', but does not withhold non-SGR seqs found in STRING.
+
+Workaround for Emacs bug#53808 whereby partial ANSI control seqs present in
+the input stream may block the whole colorization process."
+ (let* ((result (ansi-color-apply string))
+
+ ;; The STRING may end with a possible incomplete ANSI control seq
which
+ ;; the call to `ansi-color-apply' stores in the `ansi-color-context'
+ ;; fragment. If the fragment is not an incomplete ANSI color control
+ ;; sequence (aka SGR seq) though then flush it out and appended it to
+ ;; the result.
+ (fragment-flush?
+ (when-let (fragment (and ansi-color-context (cadr
ansi-color-context)))
+ (save-match-data
+ ;; Check if fragment is indeed an SGR seq in the making. The SGR
+ ;; seq is defined as starting with ESC followed by [ followed by
+ ;; zero or more [:digit:]+; followed by one or more digits and
+ ;; ending with m.
+ (when (string-match
+ (rx (sequence ?\e
+ (? (and (or ?\[ eol)
+ (or (+ (any (?0 . ?9))) eol)
+ (* (sequence ?\; (+ (any (?0 .
?9)))))
+ (or ?\; eol)))))
+ fragment)
+ (let* ((sgr-end-pos (match-end 0))
+ (fragment-matches-whole? (or (= sgr-end-pos 0)
+ (= sgr-end-pos (length
fragment)))))
+ (when (not fragment-matches-whole?)
+ ;; Definitely not an partial SGR seq, flush it out of
+ ;; `ansi-color-context'.
+ t)))))))
+
+ (if (not fragment-flush?)
+ result
+
+ (progn
+ ;; Temporarily replace the ESC char in the fragment so that is flushed
+ ;; out of `ansi-color-context' by `ansi-color-apply' and append it to
+ ;; the result.
+ (aset (cadr ansi-color-context) 0 ?\0)
+ (let ((result-fragment (ansi-color-apply "")))
+ (aset result-fragment 0 ?\e)
+ (concat result result-fragment))))))
(defvar-local cider-repl--ns-forms-plist nil
"Plist holding ns->ns-form mappings within each connection.")
@@ -672,7 +710,9 @@ namespaces. STRING is REPL's output."
(put-text-property 0 (length string) 'help-echo 'cider-locref-help-echo
string)
string)
-(defvar cider-repl-preoutput-hook '(ansi-color-apply
+(defvar cider-repl-preoutput-hook `(,(if (< emacs-major-version 29)
+ 'cider-repl--ansi-color-apply
+ 'ansi-color-apply)
cider-repl-highlight-current-project
cider-repl-highlight-spec-keywords
cider-repl-add-locref-help-echo)
@@ -729,8 +769,7 @@ Before inserting, run `cider-repl-preoutput-hook' on
STRING."
'font-lock-face face
'rear-nonsticky '(font-lock-face)))
(setq string (cider-run-chained-hook 'cider-repl-preoutput-hook
string))
- (insert-before-markers string)
- (cider-repl--flush-ansi-color-context))
+ (insert-before-markers string))
(when (and (= (point) cider-repl-prompt-start-mark)
(not (bolp)))
(insert-before-markers "\n")
diff --git a/test/cider-repl-tests.el b/test/cider-repl-tests.el
index 777a7b715e..2fcfbfe77e 100644
--- a/test/cider-repl-tests.el
+++ b/test/cider-repl-tests.el
@@ -106,9 +106,35 @@
(cider-repl--emit-output (current-buffer) "[30ma[0m\n"
'cider-repl-stdout-face)
(cider-repl--emit-output (current-buffer) "b\n"
'cider-repl-stdout-face)
(cider-repl--emit-output (current-buffer) "[31mc\n"
'cider-repl-stdout-face)
- (cider-repl--emit-output (current-buffer) "d[0m\n"
'cider-repl-stdout-face)
+ ;; split at ESC
+ (cider-repl--emit-output (current-buffer) "" 'cider-repl-stdout-face)
+ (cider-repl--emit-output (current-buffer) "[32md\n"
'cider-repl-stdout-face)
+ ;; split at ESC [
+ (cider-repl--emit-output (current-buffer) "[" 'cider-repl-stdout-face)
+ (cider-repl--emit-output (current-buffer) "33me\n"
'cider-repl-stdout-face)
- (expect (buffer-string) :to-equal "a\nb\nc\nd\n")
+ ;; split at ESC [n
+ (cider-repl--emit-output (current-buffer) "[3"
'cider-repl-stdout-face)
+ (cider-repl--emit-output (current-buffer) "1mf\n"
'cider-repl-stdout-face)
+
+ ;; split at ESC [nm
+ (cider-repl--emit-output (current-buffer) "[32m"
'cider-repl-stdout-face)
+ (cider-repl--emit-output (current-buffer) "g\n"
'cider-repl-stdout-face)
+
+ ;; split at ESC [n;
+ (cider-repl--emit-output (current-buffer) "[1;"
'cider-repl-stdout-face)
+ (cider-repl--emit-output (current-buffer) "33mh\n"
'cider-repl-stdout-face)
+
+ ;; split at ESC [n;n
+ (cider-repl--emit-output (current-buffer) "[0;31"
'cider-repl-stdout-face)
+ (cider-repl--emit-output (current-buffer) "mi\n"
'cider-repl-stdout-face)
+
+ ;; split at ESC [n;nm
+ (cider-repl--emit-output (current-buffer) "[3;32m"
'cider-repl-stdout-face)
+ (cider-repl--emit-output (current-buffer) "j[0m\n"
'cider-repl-stdout-face)
+
+ (expect (buffer-substring-no-properties (point-min) (point-max))
+ :to-equal "a\nb\nc\nd\ne\nf\ng\nh\ni\nj\n")
(expect (get-text-property 1 'font-lock-face)
:to-equal '(foreground-color . "black"))
(expect (get-text-property 3 'font-lock-face)
@@ -116,20 +142,35 @@
(expect (get-text-property 5 'font-lock-face)
:to-equal '(foreground-color . "red3"))
(expect (get-text-property 7 'font-lock-face)
- :to-equal '(foreground-color . "red3"))))))
+ :to-equal '(foreground-color . "green3"))
+ (expect (get-text-property 9 'font-lock-face)
+ :to-equal '(foreground-color . "yellow3"))
+ (expect (get-text-property 11 'font-lock-face)
+ :to-equal '(foreground-color . "red3"))
+ (expect (get-text-property 13 'font-lock-face)
+ :to-equal '(foreground-color . "green3"))
+ (expect (get-text-property 15 'font-lock-face)
+ :to-equal '((foreground-color . "yellow3") bold))
+ (expect (get-text-property 17 'font-lock-face)
+ :to-equal '(foreground-color . "red3"))
+ (expect (get-text-property 19 'font-lock-face)
+ :to-equal '((foreground-color . "green3") italic))
+ ))))
(defun simulate-cider-output (s property)
"Return properties from `cider-repl--emit-output'.
PROPERTY should be a symbol of either 'text, 'ansi-context or
'properties."
- (with-temp-buffer
- (with-testing-ansi-table cider-testing-ansi-colors-vector
- (cider-repl-reset-markers)
- (cider-repl--emit-output (current-buffer) s nil))
- (pcase property
- (`text (substring-no-properties (buffer-string)))
- (`ansi-context ansi-color-context)
- (`properties (substring (buffer-string))))))
+ (let ((strings (if (listp s) s (list s))))
+ (with-temp-buffer
+ (with-testing-ansi-table cider-testing-ansi-colors-vector
+ (cider-repl-reset-markers)
+ (dolist (s strings)
+ (cider-repl--emit-output (current-buffer) s
nil)))
+ (pcase property
+ (`text (substring-no-properties (buffer-string)))
+ (`ansi-context ansi-color-context)
+ (`properties (substring (buffer-string)))))))
(describe "cider-repl--emit-output"
(it "prints simple strings"
@@ -142,7 +183,21 @@ PROPERTY should be a symbol of either 'text, 'ansi-context
or
(expect (simulate-cider-output "\033hi" 'text)
:to-equal "\033hi\n")
(expect (simulate-cider-output "\033hi" 'ansi-context)
- :to-equal nil)))
+ :to-equal nil)
+
+ ;; Informational: Ideally, we would have liked any non-SGR
+ ;; sequence to appear on the output verbatim, but as per the
+ ;; `ansi-color-apply' doc string, they are removed
+ ;;
+ ;; """Translates SGR control sequences into text properties.
+ ;; Delete all other control sequences without processing them."""
+ ;;
+ ;; e.g.:
+ (expect (simulate-cider-output
+ "\033[hi" 'text) :to-equal "i\n")
+ (expect (simulate-cider-output
+ '("\033[" "hi") 'text) :to-equal "i\n")
+ ))
(describe "when the escape code is valid"
(it "preserves the context"