├── .gitignore ├── Makefile ├── README.md ├── example └── example.rkt ├── info.rkt └── terminal-color ├── info.rkt ├── main.rkt ├── manual.scrbl ├── private ├── ansi.rkt ├── off.rkt └── windows.rkt └── test.rkt /.gitignore: -------------------------------------------------------------------------------- 1 | *.dep 2 | *.zo 3 | *~ 4 | terminal-color/doc 5 | htmldocs 6 | pages 7 | 8 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | PACKAGENAME=terminal-color 2 | COLLECTS=terminal-color 3 | SCRBL=terminal-color/manual.scrbl 4 | 5 | all: setup 6 | 7 | clean: 8 | find . -name compiled -type d | xargs rm -rf 9 | rm -rf htmldocs 10 | 11 | setup: 12 | raco setup $(COLLECTS) 13 | 14 | link: 15 | raco pkg install --link -n $(PACKAGENAME) $$(pwd) 16 | 17 | unlink: 18 | raco pkg remove $(PACKAGENAME) 19 | 20 | htmldocs: $(SCRBL) 21 | raco scribble \ 22 | --html \ 23 | --dest htmldocs \ 24 | --dest-name index \ 25 | ++main-xref-in \ 26 | --redirect-main http://docs.racket-lang.org/ \ 27 | \ 28 | $(SCRBL) 29 | 30 | pages: 31 | @(git branch -v | grep -q gh-pages || (echo local gh-pages branch missing; false)) 32 | @echo 33 | @git branch -av | grep gh-pages 34 | @echo 35 | @(echo 'Is the branch up to date? Press enter to continue.'; read dummy) 36 | git clone -b gh-pages . pages 37 | 38 | publish: htmldocs pages 39 | rm -rf pages/* 40 | cp -r htmldocs/. pages/. 41 | (cd pages; git add -A) 42 | -(cd pages; git commit -m "Update $$(date +%Y%m%d%H%M%S)") 43 | (cd pages; git push origin gh-pages) 44 | rm -rf pages 45 | # push to github: git push origin gh-pages 46 | 47 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | terminal-color 2 | ============== 3 | 4 | A Racket library to output colored text to the terminal on any platform, including Windows. 5 | 6 | NOTE: This library is currently in development so things may change before 7 | v1.0 is released. The current version should be usable on all platforms with 8 | Racket 5.3.6 and 6.x series. Compatability will try to be kept for existing users. 9 | 10 | Documentation 11 | ------------- 12 | 13 | A rendered version of the documentation for this library is available via Github Pages: 14 | 15 | * https://hopkinsr.github.io/terminal-color/ 16 | 17 | Example 18 | ------- 19 | 20 | In short this library provides corresponding procedures for the standard display, displayln, 21 | print and write procedures, allowing you to write things like 22 | 23 | ```racket 24 | (require terminal-color) 25 | 26 | (displayln-color "1: Default colors") 27 | (displayln-color "2: Green" #:fg 'green) 28 | (displayln-color "3: White on red" #:fg 'white #:bg 'red) 29 | ``` 30 | 31 | Requirements 32 | ------------ 33 | 34 | It should be possible to install this package as normal using raco on both Racket 5.3.6 and 6.x. 35 | 36 | -------------------------------------------------------------------------------- /example/example.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (require "../terminal-color/main.rkt") 3 | 4 | (define (display-test-output title) 5 | (displayln title) 6 | (displayln-color "1: Default colors") 7 | (displayln-color "2: Green" #:fg 'green) 8 | (displayln-color "3: White on red" #:fg 'white #:bg 'red) 9 | (newline)) 10 | 11 | (display-test-output "(guess-display-color-mode)") 12 | 13 | (parameterize ([current-display-color-mode 'off]) 14 | (display-test-output "'off")) 15 | 16 | (parameterize ([current-display-color-mode 'ansi]) 17 | (display-test-output "'ansi")) 18 | 19 | ; Only run on Windows. 20 | (when (equal? (system-type 'os) 'windows) 21 | (parameterize ([current-display-color-mode 'win32]) 22 | (display-test-output "'win32"))) 23 | 24 | (void (call-with-output-string 25 | (λ (out) 26 | (displayln-color "(current-output-port) and (current-display-color-mode)" #:fg 'cyan) 27 | (displayln-color "to output string and (current-display-color-mode)" out #:fg 'cyan)))) 28 | 29 | 30 | (time 31 | (void (for ([i (in-range 1000)]) 32 | (call-with-output-string 33 | (λ (out) 34 | (display-color (format "done ~a" i) out #:fg 'yellow)))))) 35 | -------------------------------------------------------------------------------- /info.rkt: -------------------------------------------------------------------------------- 1 | #lang setup/infotab 2 | (define version "0.5") 3 | (define collection 'multi) 4 | (define deps '("base")) 5 | (define build-deps '("scribble-lib" "racket-doc")) 6 | 7 | -------------------------------------------------------------------------------- /terminal-color/info.rkt: -------------------------------------------------------------------------------- 1 | #lang setup/infotab 2 | (define scribblings '(("manual.scrbl" ()))) 3 | -------------------------------------------------------------------------------- /terminal-color/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require racket/contract 3 | racket/list 4 | racket/runtime-path) 5 | 6 | (provide (contract-out 7 | [output-color-mode? (-> any/c boolean?)] 8 | [guess-output-color-mode (-> output-color-mode?)] 9 | [current-output-color-mode (parameter/c output-color-mode?)] 10 | [current-output-color-fg (parameter/c terminal-color?)] 11 | [current-output-color-bg (parameter/c terminal-color?)] 12 | [terminal-color? (-> any/c boolean?)])) 13 | 14 | (provide (contract-out 15 | [display-color (->* (any/c) (output-port? #:fg terminal-color? #:bg terminal-color?) void?)] 16 | [displayln-color (->* (any/c) (output-port? #:fg terminal-color? #:bg terminal-color?) void?)] 17 | [print-color (->* (any/c) (output-port? (or/c 0 1) #:fg terminal-color? #:bg terminal-color?) void?)] 18 | [write-color (->* (any/c) (output-port? #:fg terminal-color? #:bg terminal-color?) void?)])) 19 | 20 | ; compatibility: used before v1 21 | (provide (contract-out 22 | [current-display-color-mode (parameter/c output-color-mode?)] 23 | [guess-display-color-mode (-> output-color-mode?)])) 24 | 25 | (define-runtime-path off-plugin-path "private/off.rkt") 26 | (define-runtime-path ansi-plugin-path "private/ansi.rkt") 27 | (define-runtime-path windows-plugin-path "private/windows.rkt") 28 | 29 | ; compatibility: win32 was used before v1 30 | (define (output-color-mode? v) 31 | (case v 32 | [(off ansi win32 windows) #t] 33 | [else #f])) 34 | 35 | (define (guess-output-color-mode) 36 | (if (terminal-port? (current-output-port)) 37 | (case (system-type 'os) 38 | [(unix macosx) 'ansi] 39 | [(windows) 'windows] 40 | [else 'off]) 41 | 'off)) 42 | 43 | (define current-output-color-mode (make-parameter (guess-output-color-mode))) 44 | (define current-output-color-fg (make-parameter 'default)) 45 | (define current-output-color-bg (make-parameter 'default)) 46 | 47 | (define (terminal-color? v) 48 | (case v 49 | [(default 50 | black white 51 | red green blue 52 | cyan magenta yellow) 53 | #t] 54 | [else #f])) 55 | 56 | (define-namespace-anchor plugin-anchor) 57 | 58 | (define (load-plug-in file proc) 59 | (let ([ns (namespace-anchor->namespace plugin-anchor)]) 60 | (parameterize ([current-namespace ns]) 61 | (dynamic-require file proc)))) 62 | 63 | (struct plugin (mode name method)) 64 | 65 | (define possible-plugins-to-load 66 | (let ([standard-plugins (list `(off ,off-plugin-path) 67 | `(ansi ,ansi-plugin-path))]) 68 | (if (equal? (system-type 'os) 'windows) 69 | (cons `(windows ,windows-plugin-path) standard-plugins) 70 | standard-plugins))) 71 | 72 | (define plugin-cache 73 | (for*/list ([p possible-plugins-to-load] 74 | [name '(display-color displayln-color print-color write-color)]) 75 | (let ([mode (first p)] 76 | [file (second p)]) 77 | (plugin mode name (load-plug-in file name))))) 78 | 79 | (define (get-cached-plugin name [mode (current-output-color-mode)]) 80 | (define matching (filter (λ (p) 81 | (and (equal? (plugin-mode p) mode) 82 | (equal? (plugin-name p) name))) 83 | plugin-cache)) 84 | (first matching)) 85 | 86 | (define (get-cached-plugin-method name [mode (current-output-color-mode)]) 87 | (plugin-method (get-cached-plugin name mode))) 88 | 89 | (define (display-color datum [out (current-output-port)] #:fg [fg (current-output-color-fg)] #:bg [bg (current-output-color-bg)]) 90 | (define display-variant (get-cached-plugin-method 'display-color)) 91 | (display-variant datum out #:fg fg #:bg bg)) 92 | 93 | (define (displayln-color datum [out (current-output-port)] #:fg [fg (current-output-color-fg)] #:bg [bg (current-output-color-bg)]) 94 | (define displayln-variant (get-cached-plugin-method 'displayln-color)) 95 | (displayln-variant datum out #:fg fg #:bg bg)) 96 | 97 | (define (print-color datum [out (current-output-port)] [quote-depth 0] #:fg [fg (current-output-color-fg)] #:bg [bg (current-output-color-bg)]) 98 | (define print-variant (get-cached-plugin-method 'print-color)) 99 | (print-variant datum out quote-depth #:fg fg #:bg bg)) 100 | 101 | (define (write-color datum [out (current-output-port)] #:fg [fg (current-output-color-fg)] #:bg [bg (current-output-color-bg)]) 102 | (define write-variant (get-cached-plugin-method 'write-color)) 103 | (write-variant datum out #:fg fg #:bg bg)) 104 | 105 | ; compatibility 106 | (define current-display-color-mode current-output-color-mode) 107 | (define guess-display-color-mode guess-output-color-mode) 108 | -------------------------------------------------------------------------------- /terminal-color/manual.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @(require scribble/eval) 3 | @(require (for-label racket 4 | terminal-color)) 5 | 6 | @author{Richard Hopkins} 7 | @title[#:version "0.5"]{terminal-color} 8 | 9 | A Racket library to output colored text to the terminal on any platform, 10 | including Windows. 11 | 12 | @section{Introduction} 13 | 14 | Racket provides several procedures for outputting data, namely 15 | @racket[display], @racket[displayln], @racket[print] and 16 | @racket[write]. This library provides a corresponding procedure for each of 17 | them with the ability to specify what foreground and background color to use. 18 | 19 | The signature for these procedures is compatible with the standard ones, as 20 | the foreground and background colors are specified using optional keyword 21 | arguments. This means any existing call to the standard procedures can easily 22 | be modified to use this library as only the name changes. 23 | 24 | See the API section for what is provided and further usage instructions. 25 | 26 | @section{Requirements} 27 | 28 | This library is compatible with Racket 5.3.6, 6.x and can be installed using 29 | the normal raco pkg commands on any platform. 30 | 31 | @section{Examples} 32 | 33 | @examples[(require racket/port 34 | terminal-color) 35 | 36 | (define (display-test-output title) 37 | (displayln title) 38 | (displayln-color "1: Default colors") 39 | (displayln-color "2: Green" #:fg 'green) 40 | (displayln-color "3: White on red" #:fg 'white #:bg 'red) 41 | (newline)) 42 | 43 | (display-test-output "(guess-output-color-mode)") 44 | 45 | (parameterize ([current-output-color-mode 'off]) 46 | (display-test-output "'off")) 47 | 48 | (parameterize ([current-output-color-mode 'ansi]) 49 | (display-test-output "'ansi")) 50 | 51 | ; Only run on Windows. 52 | (when (equal? (system-type 'os) 'windows) 53 | (parameterize ([current-output-color-mode 'windows]) 54 | (display-test-output "'windows"))) 55 | 56 | (void (call-with-output-string 57 | (λ (out) 58 | (displayln-color "(current-output-port) and (current-output-color-mode)" #:fg 'cyan) 59 | (displayln-color "to output string and (current-output-color-mode)" out #:fg 'cyan))))] 60 | 61 | @section{API} 62 | 63 | @defmodule[terminal-color] 64 | 65 | @defproc[(output-color-mode? [v any/c]) boolean?]{ 66 | Returns @racket[#t] if @racket[v] is a valid output color mode, @racket[#f] otherwise. 67 | 68 | Valid modes are 69 | 70 | @itemlist[@item[@racket['off]] 71 | @item[@racket['ansi]] 72 | @item[@racket['win32] @(deprecated #:what "'win32" "'windows")] 73 | @item[@racket['windows]]] 74 | } 75 | 76 | @defparam[current-output-color-mode mode output-color-mode? 77 | #:value (guess-output-color-mode)]{ 78 | A parameter that defines the current output color mode used by @code["display-color"], @code["displayln-color"], @code["print-color"], @code["write-color"]. 79 | Default value is the result of @code["guess-output-color-mode"]. 80 | } 81 | 82 | @defparam[current-display-color-mode mode output-color-mode? 83 | #:value (guess-output-color-mode)]{ 84 | @(deprecated #:what "current-display-color-mode" "current-output-color-mode") 85 | } 86 | 87 | @defparam[current-output-color-fg mode terminal-color? 88 | #:value 'default]{ 89 | A parameter that defines the current foreground color used by @code["display-color"], @code["displayln-color"], @code["print-color"], @code["write-color"] 90 | unless one is explicitly specified. 91 | Default value is @racket['default]. 92 | } 93 | 94 | @defparam[current-output-color-bg mode terminal-color? 95 | #:value 'default]{ 96 | A parameter that defines the current background color used by @code["display-color"], @code["displayln-color"], @code["print-color"], @code["write-color"] 97 | unless one is explicitly specified. 98 | Default value is @racket['default]. 99 | } 100 | 101 | @defproc[(guess-output-color-mode) output-color-mode?]{ 102 | A helper to provide a sane value for @code["current-output-color-mode"]. 103 | 104 | If the output is to a terminal then the operating system is checked: 105 | unix-like will use ANSI codes (@racket['ansi]) and Windows will use Win32 106 | API calls (@racket['windows]). Everything else will do nothing (@racket['off]). 107 | } 108 | 109 | @defproc[(guess-display-color-mode) output-color-mode?]{ 110 | @(deprecated #:what "guess-display-color-mode" "guess-output-color-mode") 111 | } 112 | 113 | @defproc[(terminal-color? [v any/c]) boolean?]{ 114 | Returns @racket[#t] if @racket[v] is a valid color, @racket[#f] otherwise. 115 | 116 | Valid colors are 117 | 118 | @itemlist[@item[@racket['default]] 119 | @item[@racket['black]] 120 | @item[@racket['white]] 121 | @item[@racket['red]] 122 | @item[@racket['green]] 123 | @item[@racket['blue]] 124 | @item[@racket['cyan]] 125 | @item[@racket['magenta]] 126 | @item[@racket['yellow]]] 127 | } 128 | 129 | @defproc[(display-color [datum any/c] [out output-port? (current-output-port)] [#:fg fg terminal-color? (current-output-color-fg)] [#:bg bg terminal-color? (current-output-color-bg)]) 130 | void?]{ 131 | A wrapper for the standard @code["display"] procedure that will output @racket[datum] 132 | in the requested color if possible followed by resetting the terminal color. 133 | } 134 | 135 | @defproc[(displayln-color [datum any/c] [out output-port? (current-output-port)] [#:fg fg terminal-color? (current-output-color-fg)] [#:bg bg terminal-color? (current-output-color-bg)]) 136 | void?]{ 137 | A wrapper for the standard @code["displayln"] procedure that will output @racket[datum] 138 | in the requested color if possible followed by resetting the terminal color. 139 | 140 | It's recommended to use this instead of @code["display-color"] for strings that end with a new line. 141 | This is because it will reset the terminal color before the new line as it can be significant on some terminals. 142 | } 143 | 144 | @defproc[(print-color [datum any/c] [out output-port? (current-output-port)] [quote-depth (or/c 0 1) 0] [#:fg fg terminal-color? (current-output-color-fg)] [#:bg bg terminal-color? (current-output-color-bg)]) 145 | void?]{ 146 | A wrapper for the standard @code["print"] procedure that will output @racket[datum] 147 | in the requested color if possible followed by resetting the terminal color. 148 | } 149 | 150 | @defproc[(write-color [datum any/c] [out output-port? (current-output-port)] [#:fg fg terminal-color? (current-output-color-fg)] [#:bg bg terminal-color? (current-output-color-bg)]) 151 | void?]{ 152 | A wrapper for the standard @code["write"] procedure that will output @racket[datum] 153 | in the requested color if possible followed by resetting the terminal color. 154 | } 155 | -------------------------------------------------------------------------------- /terminal-color/private/ansi.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (provide display-color 3 | displayln-color 4 | print-color 5 | write-color) 6 | 7 | ; https://github.com/stamourv/roguelike/blob/master/utilities/terminal.rkt 8 | (define (terminal-command out command) 9 | (fprintf out "~a~a" (integer->char #x1b) command)) 10 | 11 | (define (terminal-reset out) 12 | (terminal-command out "[0m")) 13 | 14 | (define (terminal-colors out bg fg [bold? #f] [underline? #f]) 15 | (terminal-command out 16 | (format "[~a;~a~a~am" 17 | (case bg 18 | ((black) "40") ((red) "41") 19 | ((green) "42") ((yellow) "43") 20 | ((blue) "44") ((magenta) "45") 21 | ((cyan) "46") ((white) "47") 22 | ((default) "49")) 23 | (case fg 24 | ((black) "30") ((red) "31") 25 | ((green) "32") ((yellow) "33") 26 | ((blue) "34") ((magenta) "35") 27 | ((cyan) "36") ((white) "37") 28 | ((default) "39")) 29 | (if bold? ";1" "") 30 | (if underline? ";4" "")))) 31 | 32 | (define (output-color output-method datum out #:fg fg #:bg bg) 33 | (terminal-colors out bg fg #f #f) 34 | (output-method datum out) 35 | (terminal-reset out)) 36 | 37 | (define (display-color datum out #:fg fg #:bg bg) 38 | (output-color display datum out #:fg fg #:bg bg)) 39 | 40 | (define (displayln-color datum out #:fg fg #:bg bg) 41 | (terminal-colors out bg fg #f #f) 42 | (display datum out) 43 | (terminal-reset out) 44 | (newline out)) 45 | 46 | (define (print-color datum out quote-depth #:fg fg #:bg bg) 47 | (terminal-colors bg fg #f #f) 48 | (print datum out quote-depth) 49 | (terminal-reset out)) 50 | 51 | (define (write-color datum out #:fg fg #:bg bg) 52 | (output-color write datum out #:fg fg #:bg bg)) 53 | -------------------------------------------------------------------------------- /terminal-color/private/off.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (provide display-color 3 | displayln-color 4 | print-color 5 | write-color) 6 | 7 | (define (display-color datum out #:fg fg #:bg bg) 8 | (display datum out)) 9 | 10 | (define (displayln-color datum out #:fg fg #:bg bg) 11 | (displayln datum out)) 12 | 13 | (define (print-color datum out quote-depth #:fg fg #:bg bg) 14 | (print datum out quote-depth)) 15 | 16 | (define (write-color datum out #:fg fg #:bg bg) 17 | (write datum out)) 18 | 19 | -------------------------------------------------------------------------------- /terminal-color/private/windows.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (provide display-color 3 | displayln-color 4 | print-color 5 | write-color) 6 | 7 | (require ffi/unsafe 8 | ffi/unsafe/define) 9 | 10 | (define-ffi-definer define-win32-terminal (ffi-lib "kernel32")) 11 | (define-win32-terminal GetStdHandle (_fun _int -> _intptr)) 12 | (define-win32-terminal SetConsoleTextAttribute (_fun _intptr _int16 -> _int)) 13 | 14 | (define STD_OUTPUT_HANDLE -11) 15 | 16 | (define FOREGROUND_BLUE 1) 17 | (define FOREGROUND_GREEN 2) 18 | (define FOREGROUND_RED 4) 19 | (define FOREGROUND_INTENSITY 8) 20 | (define BACKGROUND_BLUE 16) 21 | (define BACKGROUND_GREEN 32) 22 | (define BACKGROUND_RED 64) 23 | (define BACKGROUND_INTENSITY 128) 24 | 25 | (define FOREGROUND_CYAN (bitwise-ior FOREGROUND_BLUE FOREGROUND_GREEN)) 26 | (define FOREGROUND_MAGENTA (bitwise-ior FOREGROUND_BLUE FOREGROUND_RED)) 27 | (define FOREGROUND_YELLOW (bitwise-ior FOREGROUND_GREEN FOREGROUND_RED)) 28 | (define FOREGROUND_WHITE (bitwise-ior FOREGROUND_BLUE FOREGROUND_GREEN FOREGROUND_RED)) 29 | (define FOREGROUND_BLACK 0) 30 | 31 | (define BACKGROUND_CYAN (bitwise-ior BACKGROUND_BLUE BACKGROUND_GREEN)) 32 | (define BACKGROUND_MAGENTA (bitwise-ior BACKGROUND_BLUE BACKGROUND_RED)) 33 | (define BACKGROUND_YELLOW (bitwise-ior BACKGROUND_GREEN BACKGROUND_RED)) 34 | (define BACKGROUND_WHITE (bitwise-ior BACKGROUND_BLUE BACKGROUND_GREEN BACKGROUND_RED)) 35 | (define BACKGROUND_BLACK 0) 36 | 37 | (define console (GetStdHandle STD_OUTPUT_HANDLE)) 38 | 39 | (define (set-terminal-color! fg bg) 40 | (flush-output) 41 | (define bgattr (case bg 42 | ((black) BACKGROUND_BLACK) ((red) BACKGROUND_RED) 43 | ((green) BACKGROUND_GREEN) ((yellow) BACKGROUND_YELLOW) 44 | ((blue) BACKGROUND_BLUE) ((magenta) BACKGROUND_MAGENTA) 45 | ((cyan) BACKGROUND_CYAN) ((white) BACKGROUND_WHITE) 46 | ((default) BACKGROUND_BLACK))) 47 | (define fgattr (case fg 48 | ((black) FOREGROUND_BLACK) ((red) FOREGROUND_RED) 49 | ((green) FOREGROUND_GREEN) ((yellow) FOREGROUND_YELLOW) 50 | ((blue) FOREGROUND_BLUE) ((magenta) FOREGROUND_MAGENTA) 51 | ((cyan) FOREGROUND_CYAN) ((white) FOREGROUND_WHITE) 52 | ((default) FOREGROUND_WHITE))) 53 | (SetConsoleTextAttribute console (bitwise-ior fgattr bgattr)) 54 | (void)) 55 | 56 | (define (reset-terminal-color!) 57 | (set-terminal-color! 'white 'black)) 58 | 59 | (define (output-color output-method datum out #:fg fg #:bg bg) 60 | (set-terminal-color! fg bg) 61 | (output-method datum out) 62 | (reset-terminal-color!)) 63 | 64 | (define (display-color datum out #:fg fg #:bg bg) 65 | (output-color display datum out #:fg fg #:bg bg)) 66 | 67 | (define (displayln-color datum out #:fg fg #:bg bg) 68 | (set-terminal-color! fg bg) 69 | (display datum out) 70 | (reset-terminal-color!) 71 | (newline out)) 72 | 73 | (define (print-color datum out quote-depth #:fg fg #:bg bg) 74 | (set-terminal-color! fg bg) 75 | (print datum out quote-depth) 76 | (reset-terminal-color!)) 77 | 78 | (define (write-color datum out #:fg fg #:bg bg) 79 | (output-color write datum out #:fg fg #:bg bg)) 80 | -------------------------------------------------------------------------------- /terminal-color/test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (require rackunit 3 | "main.rkt") 4 | 5 | ;; off: must pass straight through with no changes 6 | (parameterize ([current-output-color-mode 'off]) 7 | ;; display 8 | (check-equal? (call-with-output-string 9 | (λ (out) 10 | (display-color "123" out #:fg 'yellow))) 11 | "123") 12 | (check-equal? (call-with-output-string 13 | (λ (out) 14 | (display-color "123\n456" out #:fg 'yellow))) 15 | "123\n456") 16 | ;; displayln 17 | (check-equal? (call-with-output-string 18 | (λ (out) 19 | (displayln-color "123" out #:fg 'yellow))) 20 | "123\n")) 21 | 22 | ;; ansi: 23 | ;; TODO: Maybe we could check for the actual generated ANSI codes 24 | ;; but for now just check the output is changed in someway. 25 | (parameterize ([current-output-color-mode 'ansi]) 26 | ;; display 27 | (check-not-equal? (call-with-output-string 28 | (λ (out) 29 | (display-color "123" out #:fg 'yellow))) 30 | "123") 31 | (check-not-equal? (call-with-output-string 32 | (λ (out) 33 | (display-color "123\n456" out #:fg 'yellow))) 34 | "123\n456") 35 | ;; displayln 36 | (check-not-equal? (call-with-output-string 37 | (λ (out) 38 | (displayln-color "123" out #:fg 'yellow))) 39 | "123")) --------------------------------------------------------------------------------