525 lines
19 KiB
Scheme
525 lines
19 KiB
Scheme
|
;; Copyright (c) 2010-2014 Alex Shinn. All rights reserved. BSD-style
|
||
|
|
;; license: http://synthcode.com/license.txt
|
||
|
|
|
||
|
|
;;> A library to use ANSI escape codes to format text and background
|
||
|
|
;;> color, font weigh, and underlining.
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
|
||
|
|
(define (make-simple-escape-procedure parameter)
|
||
|
|
(let ((code (string-append "\x1B;[" (number->string parameter) "m")))
|
||
|
|
(lambda () code)))
|
||
|
|
|
||
|
|
(define (make-wrap-procedure start-escape end-escape)
|
||
|
|
(lambda (str)
|
||
|
|
(if (not (string? str))
|
||
|
|
(error "argument must be a string" str))
|
||
|
|
(if (ansi-escapes-enabled?)
|
||
|
|
(string-append start-escape str end-escape)
|
||
|
|
str)))
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
|
||
|
|
;; Some definitions are wrapped in begin in order to avoid Scribble
|
||
|
|
;; generating duplicate signatures.
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
|
||
|
|
;;> \section{Library}
|
||
|
|
|
||
|
|
(define black-escape
|
||
|
|
(make-simple-escape-procedure 30))
|
||
|
|
(define red-escape
|
||
|
|
(make-simple-escape-procedure 31))
|
||
|
|
(define green-escape
|
||
|
|
(make-simple-escape-procedure 32))
|
||
|
|
(define yellow-escape
|
||
|
|
(make-simple-escape-procedure 33))
|
||
|
|
(define blue-escape
|
||
|
|
(make-simple-escape-procedure 34))
|
||
|
|
(define magenta-escape
|
||
|
|
(make-simple-escape-procedure 35))
|
||
|
|
(define cyan-escape
|
||
|
|
(make-simple-escape-procedure 36))
|
||
|
|
(define white-escape
|
||
|
|
(make-simple-escape-procedure 37))
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select the
|
||
|
|
;;> specified text color.
|
||
|
|
;;/
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select the
|
||
|
|
;;> text color specified by the \var{red-level}, \var{green-level},
|
||
|
|
;;> and \var{blue-level} arguments, each of which must be an exact
|
||
|
|
;;> integer in the range [0, 5].
|
||
|
|
;;>
|
||
|
|
;;> The caller is resonsible for verifying that the terminal supports
|
||
|
|
;;> 256 colors.
|
||
|
|
|
||
|
|
(define (rgb-escape red-level green-level blue-level)
|
||
|
|
(when (not (and (exact-integer? red-level) (<= 0 red-level 5)))
|
||
|
|
(error "invalid red-level value" red-level))
|
||
|
|
(when (not (and (exact-integer? green-level) (<= 0 green-level 5)))
|
||
|
|
(error "invalid green-level value" green-level))
|
||
|
|
(when (not (and (exact-integer? blue-level) (<= 0 blue-level 5)))
|
||
|
|
(error "invalid blue-level value" blue-level))
|
||
|
|
(string-append
|
||
|
|
"\x1B;[38;5;"
|
||
|
|
(number->string (+ (* 36 red-level) (* 6 green-level) blue-level 16))
|
||
|
|
"m"))
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select the
|
||
|
|
;;> text color specified by the \var{gray-level} argument, which must
|
||
|
|
;;> be an exact integer in the range [0, 23].
|
||
|
|
;;>
|
||
|
|
;;> The caller is resonsible for verifying that the terminal supports
|
||
|
|
;;> 256 colors.
|
||
|
|
|
||
|
|
(define (gray-escape gray-level)
|
||
|
|
(when (not (and (exact-integer? gray-level) (<= 0 gray-level 23)))
|
||
|
|
(error "invalid gray-level value" gray-level))
|
||
|
|
(string-append "\x1B;[38;5;"
|
||
|
|
(number->string (+ gray-level 232))
|
||
|
|
"m"))
|
||
|
|
|
||
|
|
;;> The true-color equivalent of \scheme{rgb-escape}. Return a string
|
||
|
|
;;> consisting of an ANSI escape code to select the text color
|
||
|
|
;;> specified by the \var{red-level}, \var{green-level}, and
|
||
|
|
;;> \var{blue-level} arguments, each of which must be an exact integer
|
||
|
|
;;> in the range [0, 255].
|
||
|
|
|
||
|
|
(define (rgb24-escape red-level green-level blue-level)
|
||
|
|
(when (not (and (exact-integer? red-level) (<= 0 red-level 255)))
|
||
|
|
(error "invalid red-level value" red-level))
|
||
|
|
(when (not (and (exact-integer? green-level) (<= 0 green-level 255)))
|
||
|
|
(error "invalid green-level value" green-level))
|
||
|
|
(when (not (and (exact-integer? blue-level) (<= 0 blue-level 255)))
|
||
|
|
(error "invalid blue-level value" blue-level))
|
||
|
|
(string-append
|
||
|
|
"\x1B;[38;2;"
|
||
|
|
(number->string red-level) ";"
|
||
|
|
(number->string green-level) ";"
|
||
|
|
(number->string blue-level)
|
||
|
|
"m"))
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select the
|
||
|
|
;;> default text color.
|
||
|
|
|
||
|
|
(define reset-color-escape
|
||
|
|
(make-simple-escape-procedure 39))
|
||
|
|
|
||
|
|
(define black
|
||
|
|
(make-wrap-procedure (black-escape)
|
||
|
|
(reset-color-escape)))
|
||
|
|
(define red
|
||
|
|
(make-wrap-procedure (red-escape)
|
||
|
|
(reset-color-escape)))
|
||
|
|
(define green
|
||
|
|
(make-wrap-procedure (green-escape)
|
||
|
|
(reset-color-escape)))
|
||
|
|
(define yellow
|
||
|
|
(make-wrap-procedure (yellow-escape)
|
||
|
|
(reset-color-escape)))
|
||
|
|
(define blue
|
||
|
|
(make-wrap-procedure (blue-escape)
|
||
|
|
(reset-color-escape)))
|
||
|
|
(define magenta
|
||
|
|
(make-wrap-procedure (magenta-escape)
|
||
|
|
(reset-color-escape)))
|
||
|
|
(define cyan
|
||
|
|
(make-wrap-procedure (cyan-escape)
|
||
|
|
(reset-color-escape)))
|
||
|
|
(define white
|
||
|
|
(make-wrap-procedure (white-escape)
|
||
|
|
(reset-color-escape)))
|
||
|
|
|
||
|
|
;;> If ANSI escapes are enabled, return a string consisting of the
|
||
|
|
;;> string \var{str} with a prefix that selects specified text color
|
||
|
|
;;> and a suffix that selects the default text color.
|
||
|
|
;;>
|
||
|
|
;;> If ANSI escapes are not enabled, return \var{str}.
|
||
|
|
;;/
|
||
|
|
|
||
|
|
;;> Returns a procedure which takes a single argument, a string, and
|
||
|
|
;;> which when called behaves as follows.
|
||
|
|
;;>
|
||
|
|
;;> If ANSI escapes are enabled, the procedure returns a string
|
||
|
|
;;> consisting of its argument with a prefix that selects specified
|
||
|
|
;;> text color (obtained by calling the \scheme{rgb-escape} procedure
|
||
|
|
;;> with the values of the \var{red-level}, \var{green-level}, and
|
||
|
|
;;> \var{blue-level} arguments) and a suffix that selects the default
|
||
|
|
;;> text color.
|
||
|
|
;;>
|
||
|
|
;;> If ANSI escapes are not enabled, the procedure returns its argument.
|
||
|
|
;;>
|
||
|
|
;;> The caller is resonsible for verifying that the terminal supports
|
||
|
|
;;> 256 colors.
|
||
|
|
|
||
|
|
(define (rgb red-level green-level blue-level)
|
||
|
|
(make-wrap-procedure (rgb-escape red-level green-level blue-level)
|
||
|
|
(reset-color-escape)))
|
||
|
|
|
||
|
|
;;> Returns a procedure which takes a single argument, a string, and
|
||
|
|
;;> which when called behaves as follows.
|
||
|
|
;;>
|
||
|
|
;;> If ANSI escapes are enabled, the procedure returns a string
|
||
|
|
;;> consisting of its argument with a prefix that selects specified
|
||
|
|
;;> text color (obtained by calling the \scheme{gray-escape} procedure
|
||
|
|
;;> with the values of the \var{gray-level} argument) and a suffix
|
||
|
|
;;> that selects the default text color.
|
||
|
|
;;>
|
||
|
|
;;> If ANSI escapes are not enabled, the procedure returns its argument.
|
||
|
|
;;>
|
||
|
|
;;> The caller is resonsible for verifying that the terminal supports
|
||
|
|
;;> 256 colors.
|
||
|
|
|
||
|
|
(define (gray gray-level)
|
||
|
|
(make-wrap-procedure (gray-escape gray-level)
|
||
|
|
(reset-color-escape)))
|
||
|
|
|
||
|
|
;;> The true-color equivalent of \scheme{rbg}, extending the ranges
|
||
|
|
;;> to [0, 255].
|
||
|
|
|
||
|
|
(define (rgb24 red-level green-level blue-level)
|
||
|
|
(make-wrap-procedure (rgb24-escape red-level green-level blue-level)
|
||
|
|
(reset-color-escape)))
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
|
||
|
|
(define black-background-escape
|
||
|
|
(make-simple-escape-procedure 40))
|
||
|
|
(define red-background-escape
|
||
|
|
(make-simple-escape-procedure 41))
|
||
|
|
(define green-background-escape
|
||
|
|
(make-simple-escape-procedure 42))
|
||
|
|
(define yellow-background-escape
|
||
|
|
(make-simple-escape-procedure 43))
|
||
|
|
(define blue-background-escape
|
||
|
|
(make-simple-escape-procedure 44))
|
||
|
|
(define magenta-background-escape
|
||
|
|
(make-simple-escape-procedure 45))
|
||
|
|
(define cyan-background-escape
|
||
|
|
(make-simple-escape-procedure 46))
|
||
|
|
(define white-background-escape
|
||
|
|
(make-simple-escape-procedure 47))
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select the
|
||
|
|
;;> specified background color.
|
||
|
|
;;/
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select the
|
||
|
|
;;> background color specified by the \var{red-level}, \var{green-level},
|
||
|
|
;;> and \var{blue-level} arguments, each of which must be an exact
|
||
|
|
;;> integer in the range [0, 5].
|
||
|
|
;;>
|
||
|
|
;;> The caller is resonsible for verifying that the terminal supports
|
||
|
|
;;> 256 colors.
|
||
|
|
|
||
|
|
(define (rgb-background-escape red-level green-level blue-level)
|
||
|
|
(when (not (and (exact-integer? red-level) (<= 0 red-level 5)))
|
||
|
|
(error "invalid red-level value" red-level))
|
||
|
|
(when (not (and (exact-integer? green-level) (<= 0 green-level 5)))
|
||
|
|
(error "invalid green-level value" green-level))
|
||
|
|
(when (not (and (exact-integer? blue-level) (<= 0 blue-level 5)))
|
||
|
|
(error "invalid blue-level value" blue-level))
|
||
|
|
(string-append
|
||
|
|
"\x1B;[48;5;"
|
||
|
|
(number->string (+ (* 36 red-level) (* 6 green-level) blue-level 16))
|
||
|
|
"m"))
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select the
|
||
|
|
;;> background color specified by the \var{gray-level} argument, which
|
||
|
|
;;> must be an exact integer in the range [0, 23].
|
||
|
|
;;>
|
||
|
|
;;> The caller is resonsible for verifying that the terminal supports
|
||
|
|
;;> 256 colors.
|
||
|
|
|
||
|
|
(define (gray-background-escape gray-level)
|
||
|
|
(when (not (and (exact-integer? gray-level) (<= 0 gray-level 23)))
|
||
|
|
(error "invalid gray-level value" gray-level))
|
||
|
|
(string-append "\x1B;[48;5;"
|
||
|
|
(number->string (+ gray-level 232))
|
||
|
|
"m"))
|
||
|
|
|
||
|
|
;;> The true-color equivalent of \scheme{rgb-background-escape}.
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select the
|
||
|
|
;;> text color specified by the \var{red-level}, \var{green-level},
|
||
|
|
;;> and \var{blue-level} arguments, each of which must be an exact
|
||
|
|
;;> integer in the range [0, 255].
|
||
|
|
|
||
|
|
(define (rgb24-background-escape red-level green-level blue-level)
|
||
|
|
(when (not (and (exact-integer? red-level) (<= 0 red-level 255)))
|
||
|
|
(error "invalid red-level value" red-level))
|
||
|
|
(when (not (and (exact-integer? green-level) (<= 0 green-level 255)))
|
||
|
|
(error "invalid green-level value" green-level))
|
||
|
|
(when (not (and (exact-integer? blue-level) (<= 0 blue-level 255)))
|
||
|
|
(error "invalid blue-level value" blue-level))
|
||
|
|
(string-append
|
||
|
|
"\x1B;[48;5;"
|
||
|
|
(number->string red-level) ";"
|
||
|
|
(number->string green-level) ";"
|
||
|
|
(number->string blue-level)
|
||
|
|
"m"))
|
||
|
|
|
||
|
|
;;> \procedure{(reset-background-color-escape)}
|
||
|
|
;;>
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select the
|
||
|
|
;;> default background color.
|
||
|
|
|
||
|
|
(define reset-background-color-escape
|
||
|
|
(make-simple-escape-procedure 49))
|
||
|
|
|
||
|
|
(define black-background
|
||
|
|
(make-wrap-procedure (black-background-escape)
|
||
|
|
(reset-background-color-escape)))
|
||
|
|
(define red-background
|
||
|
|
(make-wrap-procedure (red-background-escape)
|
||
|
|
(reset-background-color-escape)))
|
||
|
|
(define green-background
|
||
|
|
(make-wrap-procedure (green-background-escape)
|
||
|
|
(reset-background-color-escape)))
|
||
|
|
(define yellow-background
|
||
|
|
(make-wrap-procedure (yellow-background-escape)
|
||
|
|
(reset-background-color-escape)))
|
||
|
|
(define blue-background
|
||
|
|
(make-wrap-procedure (blue-background-escape)
|
||
|
|
(reset-background-color-escape)))
|
||
|
|
(define magenta-background
|
||
|
|
(make-wrap-procedure (magenta-background-escape)
|
||
|
|
(reset-background-color-escape)))
|
||
|
|
(define cyan-background
|
||
|
|
(make-wrap-procedure (cyan-background-escape)
|
||
|
|
(reset-background-color-escape)))
|
||
|
|
(define white-background
|
||
|
|
(make-wrap-procedure (white-background-escape)
|
||
|
|
(reset-background-color-escape)))
|
||
|
|
|
||
|
|
;;> If ANSI escapes are enabled, return a string consisting of the
|
||
|
|
;;> string \var{str} with a prefix that selects specified background
|
||
|
|
;;> color and a suffix that selects the default background color.
|
||
|
|
;;>
|
||
|
|
;;> If ANSI escapes are not enabled, return \var{str}.
|
||
|
|
;;/
|
||
|
|
|
||
|
|
;;> Returns a procedure which takes a single argument, a string, and
|
||
|
|
;;> which when called behaves as follows.
|
||
|
|
;;>
|
||
|
|
;;> If ANSI escapes are enabled, the procedure returns a string
|
||
|
|
;;> consisting of its argument with a prefix that selects specified
|
||
|
|
;;> background color (obtained by calling the \scheme{rgb-background-escape}
|
||
|
|
;;> procedure with the values of the \var{red-level}, \var{green-level},
|
||
|
|
;;> and \var{blue-level} arguments) and a suffix that selects the
|
||
|
|
;;> default background color.
|
||
|
|
;;>
|
||
|
|
;;> If ANSI escapes are not enabled, the procedure returns its argument.
|
||
|
|
;;>
|
||
|
|
;;> The caller is resonsible for verifying that the terminal supports
|
||
|
|
;;> 256 colors.
|
||
|
|
|
||
|
|
(define (rgb-background red-level green-level blue-level)
|
||
|
|
(make-wrap-procedure (rgb-background-escape red-level green-level blue-level)
|
||
|
|
(reset-background-color-escape)))
|
||
|
|
|
||
|
|
;;> Returns a procedure which takes a single argument, a string, and
|
||
|
|
;;> which when called behaves as follows.
|
||
|
|
;;>
|
||
|
|
;;> If ANSI escapes are enabled, the procedure returns a string
|
||
|
|
;;> consisting of its argument with a prefix that selects specified
|
||
|
|
;;> background color (obtained by calling the \scheme{gray-background-escape}
|
||
|
|
;;> procedure with the values of the \var{gray-level} argument) and a
|
||
|
|
;;> suffix that selects the default background color.
|
||
|
|
;;>
|
||
|
|
;;> If ANSI escapes are not enabled, the procedure returns its argument.
|
||
|
|
;;>
|
||
|
|
;;> The caller is resonsible for verifying that the terminal supports
|
||
|
|
;;> 256 colors.
|
||
|
|
|
||
|
|
(define (gray-background gray-level)
|
||
|
|
(make-wrap-procedure (gray-background-escape gray-level)
|
||
|
|
(reset-background-color-escape)))
|
||
|
|
|
||
|
|
;;> The true-color equivalent of \scheme{rbg-background}, extending
|
||
|
|
;;> the ranges to [0, 255].
|
||
|
|
|
||
|
|
(define (rgb24-background red-level green-level blue-level)
|
||
|
|
(make-wrap-procedure
|
||
|
|
(rgb24-background-escape red-level green-level blue-level)
|
||
|
|
(reset-background-color-escape)))
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select bold
|
||
|
|
;;> style.
|
||
|
|
|
||
|
|
(define bold-escape
|
||
|
|
(make-simple-escape-procedure 1))
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select non-bold
|
||
|
|
;;> style.
|
||
|
|
|
||
|
|
(define reset-bold-escape
|
||
|
|
(make-simple-escape-procedure 22))
|
||
|
|
|
||
|
|
;;> If ANSI escapes are enabled, return a string consisting of the
|
||
|
|
;;> string \var{str} with a prefix that selects bold style and a suffix
|
||
|
|
;;> that selects non-bold style.
|
||
|
|
;;>
|
||
|
|
;;> If ANSI escapes are not enabled, return \var{str}.
|
||
|
|
|
||
|
|
(define bold (make-wrap-procedure (bold-escape)
|
||
|
|
(reset-bold-escape)))
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select
|
||
|
|
;;> underlined style.
|
||
|
|
|
||
|
|
(define underline-escape
|
||
|
|
(make-simple-escape-procedure 4))
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select
|
||
|
|
;;> non-underlined style.
|
||
|
|
|
||
|
|
(define reset-underline-escape
|
||
|
|
(make-simple-escape-procedure 24))
|
||
|
|
|
||
|
|
;;> If ANSI escapes are enabled, return a string consisting of the
|
||
|
|
;;> string \var{str} with a prefix that selects underlined style and
|
||
|
|
;;> a suffix that selects non-underlined style.
|
||
|
|
;;>
|
||
|
|
;;> If ANSI escapes are not enabled, return \var{str}.
|
||
|
|
|
||
|
|
(define underline
|
||
|
|
(make-wrap-procedure (underline-escape) (reset-underline-escape)))
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select
|
||
|
|
;;> italic style.
|
||
|
|
|
||
|
|
(define italic-escape
|
||
|
|
(make-simple-escape-procedure 3))
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select
|
||
|
|
;;> non-italic style.
|
||
|
|
|
||
|
|
(define reset-italic-escape
|
||
|
|
(make-simple-escape-procedure 23))
|
||
|
|
|
||
|
|
;;> Returns \var{str} optionally wrapped in italic escapes.
|
||
|
|
|
||
|
|
(define italic
|
||
|
|
(make-wrap-procedure (italic-escape) (reset-italic-escape)))
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select
|
||
|
|
;;> strikethrough style.
|
||
|
|
|
||
|
|
(define strikethrough-escape
|
||
|
|
(make-simple-escape-procedure 9))
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select
|
||
|
|
;;> non-strikethrough style.
|
||
|
|
|
||
|
|
(define reset-strikethrough-escape
|
||
|
|
(make-simple-escape-procedure 29))
|
||
|
|
|
||
|
|
;;> Returns \var{str} optionally wrapped in strikethrough escapes.
|
||
|
|
|
||
|
|
(define strikethrough
|
||
|
|
(make-wrap-procedure (strikethrough-escape) (reset-strikethrough-escape)))
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select negative
|
||
|
|
;;> style (text in the background color and background in the text
|
||
|
|
;;> color).
|
||
|
|
|
||
|
|
(define negative-escape
|
||
|
|
(make-simple-escape-procedure 7))
|
||
|
|
|
||
|
|
;;> Return a string consisting of an ANSI escape code to select positive
|
||
|
|
;;> style (text in the text color and background in the background
|
||
|
|
;;> color).
|
||
|
|
|
||
|
|
(define reset-negative-escape
|
||
|
|
(make-simple-escape-procedure 27))
|
||
|
|
|
||
|
|
;;> If ANSI escapes are enabled, return a string consisting of the
|
||
|
|
;;> string \var{str} with a prefix that selects negative style (text
|
||
|
|
;;> in the background color and background in the text color) and a
|
||
|
|
;;> suffix that selects positive style (text in the text color and
|
||
|
|
;;> background in the background color).
|
||
|
|
;;>
|
||
|
|
;;> If ANSI escapes are not enabled, return \var{str}.
|
||
|
|
|
||
|
|
(define negative (make-wrap-procedure (negative-escape)
|
||
|
|
(reset-negative-escape)))
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
|
||
|
|
;;> A parameter object that determines whether ANSI escapes are enabled
|
||
|
|
;;> in some of the preceding procedures. They are disabled if
|
||
|
|
;;> \scheme{(ansi-escapes-enabled?)} returns \scheme{#f}, and otherwise
|
||
|
|
;;> they are enabled.
|
||
|
|
;;>
|
||
|
|
;;> The initial value returned by \scheme{(ansi-escapes-enabled?)} is
|
||
|
|
;;> determined by the environment.
|
||
|
|
;;>
|
||
|
|
;;> If the environment variable \scheme{ANSI_ESCAPES_ENABLED} is set,
|
||
|
|
;;> its value determines the initial value returned by
|
||
|
|
;;> \scheme{(ansi-escapes-enabled?)}. If the value of
|
||
|
|
;;> \scheme{ANSI_ESCAPES_ENABLED} is \scheme{"0"}, the initial value
|
||
|
|
;;> is \scheme{#f}, otherwise the initial value is \scheme{#t}.
|
||
|
|
;;>
|
||
|
|
;;> If the environment variable \scheme{ANSI_ESCAPES_ENABLED} is not
|
||
|
|
;;> set, but the environment variable \scheme{TERM} is set, the value
|
||
|
|
;;> of the latter determines the initial value returned by
|
||
|
|
;;> \scheme{(ansi-escapes-enabled?)}. If the value of \scheme{TERM}
|
||
|
|
;;> is \scheme{"xterm"}, \scheme{"xterm-color"}, \scheme{"xterm-256color"},
|
||
|
|
;;> \scheme{"rxvt"}, \scheme{"rxvt-unicode-256color"}, \scheme{"kterm"},
|
||
|
|
;;> \scheme{"linux"}, \scheme{"screen"}, \scheme{"screen-256color"},
|
||
|
|
;;> or \scheme{"vt100"}, the initial value is \scheme{#t}, otherwise
|
||
|
|
;;> the initial value is \scheme{#f}.
|
||
|
|
;;>
|
||
|
|
;;> If neither of the environment variables \scheme{ANSI_ESCAPES_ENABLED}
|
||
|
|
;;> and \scheme{TERM} are set, the initial value returned by
|
||
|
|
;;> \scheme{(ansi-escapes-enabled?)} is \scheme{#f}.
|
||
|
|
|
||
|
|
(define ansi-escapes-enabled?
|
||
|
|
(make-parameter
|
||
|
|
(cond
|
||
|
|
((get-environment-variable "ANSI_ESCAPES_ENABLED")
|
||
|
|
=> (lambda (s) (not (equal? s "0"))))
|
||
|
|
(else
|
||
|
|
(member (get-environment-variable "TERM")
|
||
|
|
'("xterm" "xterm-color" "xterm-256color" "rxvt" "kterm"
|
||
|
|
"linux" "screen" "screen-256color" "vt100"
|
||
|
|
"tmux-256color" "rxvt-unicode-256color"))))))
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
|
||
|
|
;;> \section{Notes}
|
||
|
|
;;>
|
||
|
|
;;> It is important to remember that the formatting procedures apply
|
||
|
|
;;> a prefix to set a particular graphics parameter and a suffix to
|
||
|
|
;;> reset the parameter to its default value. This can lead to surprises.
|
||
|
|
;;> For example, on an ANSI terminal, one might mistakenly expect the
|
||
|
|
;;> following to display GREEN in green text and then RED in red text:
|
||
|
|
;;>
|
||
|
|
;;> \codeblock{(display (red (string-append (green "GREEN") "RED")))}
|
||
|
|
;;>
|
||
|
|
;;> However, it will actually display GREEN in green text and then RED
|
||
|
|
;;> in the default text color. This is a limitation of ANSI control
|
||
|
|
;;> codes; graphics attributes are not saved to and restored from a
|
||
|
|
;;> stack, but instead are simply set. One way to display GREEN in
|
||
|
|
;;> green text and then RED in red text is:
|
||
|
|
;;>
|
||
|
|
;;> \codeblock{(display (string-append (green "GREEN") (red "RED")))}
|
||
|
|
;;>
|
||
|
|
;;> On the other hand, text color, background color, font weight (bold
|
||
|
|
;;> or default), underline (on or off), image (positive or negative)
|
||
|
|
;;> are orthogonal. So, for example, on an ANSI terminal the following
|
||
|
|
;;> should display GREEN in green text and then RED in red text, with
|
||
|
|
;;> both in bold and GREEN underlined.
|
||
|
|
;;>
|
||
|
|
;;> \codeblock{(display (bold (string-append (underline (green "GREEN")) (red "RED"))))}
|
||
|
|
;;>
|