perf(repl): copy clean runs in bulk in strip-ansi
ober
c6abc0b567ba52c69782759eb5967a274340ccc2
--- a/src/jerboa-emacs/repl.ss +++ b/src/jerboa-emacs/repl.ss @@ -84,45 +84,47 @@ (def esc-char (integer->char 27)) ;; ESC = 0x1B (def bel-char (integer->char 7)) ;; BEL = 0x07 +(def (strip-ansi-skip-escape str i len) + "Given an ESC at index I, return the index just past the escape sequence." + (if (< (+ i 1) len) + (let ((next (string-ref str (+ i 1)))) + (cond + ;; CSI: ESC [ ... (ends at letter 0x40-0x7E) + ((char=? next #\[) + (let skip ((j (+ i 2))) + (if (>= j len) j + (let ((c (string-ref str j))) + (if (and (char>=? c #\@) (char<=? c #\~)) + (+ j 1) + (skip (+ j 1))))))) + ;; OSC: ESC ] ... (ends at BEL or ST) + ((char=? next #\]) + (let skip ((j (+ i 2))) + (if (>= j len) j + (let ((c (string-ref str j))) + (if (or (char=? c bel-char) (char=? c esc-char)) + (+ j 1) + (skip (+ j 1))))))) + ;; Other ESC sequences (2 char) + (else (+ i 2)))) + (+ i 1))) + (def (strip-ansi str) "Remove ANSI escape sequences from a string. - Handles CSI sequences (ESC [ ... final-byte) and OSC sequences." + Handles CSI sequences (ESC [ ... final-byte) and OSC sequences. + Clean runs between escapes are copied in bulk with substring." (let ((len (string-length str)) (out (open-output-string))) - (let loop ((i 0)) - (when (< i len) - (let ((ch (string-ref str i))) - (if (char=? ch esc-char) - ;; Skip ESC sequence - (if (< (+ i 1) len) - (let ((next (string-ref str (+ i 1)))) - (cond - ;; CSI: ESC [ ... (ends at letter 0x40-0x7E) - ((char=? next #\[) - (let skip ((j (+ i 2))) - (if (>= j len) - (loop j) - (let ((c (string-ref str j))) - (if (and (char>=? c #\@) (char<=? c #\~)) - (loop (+ j 1)) - (skip (+ j 1))))))) - ;; OSC: ESC ] ... (ends at BEL or ST) - ((char=? next #\]) - (let skip ((j (+ i 2))) - (if (>= j len) - (loop j) - (let ((c (string-ref str j))) - (if (or (char=? c bel-char) - (char=? c esc-char)) - (loop (+ j 1)) - (skip (+ j 1))))))) - ;; Other ESC sequences (2 char) - (else (loop (+ i 2))))) - (loop (+ i 1))) - (begin - (write-char ch out) - (loop (+ i 1))))))) - (get-output-string out))) + (let loop ((i 0) (start 0)) + (cond + ((>= i len) + (when (> i start) (put-string out (substring str start i))) + (get-output-string out)) + ((char=? (string-ref str i) esc-char) + (when (> i start) (put-string out (substring str start i))) + (let ((j (strip-ansi-skip-escape str i len))) + (loop j j))) + (else (loop (+ i 1) start)))))) ;;;============================================================================ ;;; I/O