Vim window logic, slimv
This commit is contained in:
Ian Keane
parent
babcc9e44b
commit
515847d07e
791 changed files with 51552 additions and 86 deletions
|
|
@ -0,0 +1,13 @@
|
|||
before_script:
|
||||
- curl -O -L http://prdownloads.sourceforge.net/sbcl/sbcl-1.2.6-x86-64-linux-binary.tar.bz2
|
||||
- tar xjf sbcl-1.2.6-x86-64-linux-binary.tar.bz2
|
||||
- pushd sbcl-1.2.6-x86-64-linux/ && sudo bash install.sh && popd
|
||||
- curl -O -L http://beta.quicklisp.org/quicklisp.lisp
|
||||
- sbcl --load quicklisp.lisp --eval '(quicklisp-quickstart:install)' --eval '(quit)'
|
||||
- curl -OL http://ccl.clozure.com/ftp/pub/release/1.10/ccl-1.10-linuxx86.tar.gz
|
||||
- tar xzf ccl-1.10-linuxx86.tar.gz
|
||||
- export PATH=`pwd`/ccl:$PATH
|
||||
# - lx86cl64 -b --load quicklisp.lisp --eval '(progn (quicklisp-quickstart:install) (quit))'
|
||||
|
||||
script:
|
||||
- ./ci-test-run.sh
|
||||
|
|
@ -0,0 +1,140 @@
|
|||
# cl-ansi-text
|
||||
|
||||
Because color in your terminal is nice.
|
||||
[](https://travis-ci.org/pnathan/cl-ansi-text)
|
||||
|
||||
## Usage example -
|
||||
```lisp
|
||||
* (ql:quickload :cl-ansi-text)
|
||||
;To load "cl-ansi-text":
|
||||
; Load 1 ASDF system:
|
||||
; cl-ansi-text
|
||||
;; Loading "cl-ansi-text"
|
||||
; => (:CL-ANSI-TEXT)
|
||||
```
|
||||
|
||||
The main macro is called `with-color`, which creates an enviroment where everything that is put on `stream` gets colored according to `color`. Color options are `:black`, `:red`, `:green`, `:yellow`, `:blue`, `:magenta`, `:cyan` and `:white`. You can also use a color structure from `CL-COLORS`, like `cl-colors:+red+`.
|
||||
|
||||
```lisp
|
||||
* (import 'cl-ansi-text:with-color)
|
||||
; => T
|
||||
* (with-color (:red)
|
||||
(princ "Gets printed red...")
|
||||
(princ "and this too!"))
|
||||
; Gets printed red...and this too!
|
||||
; => "and this too!"
|
||||
```
|
||||
|
||||
There are also functions with the name of the colors, that return the string, colored:
|
||||
```lisp
|
||||
* (import 'cl-ansi-text:yellow)
|
||||
; => T
|
||||
* (yellow "Yellow string")
|
||||
; => "Yellow string"
|
||||
* (princ (yellow "String with yellow background" :style :background))
|
||||
; "String with yellow background"
|
||||
; => "String with yellow background"
|
||||
* (import 'cl-ansi-text:red)
|
||||
; => T
|
||||
* (princ
|
||||
(concatenate
|
||||
'string
|
||||
(yellow "Five") " test results went " (red "terribly wrong") "!"))
|
||||
; Five test results went terribly wrong!
|
||||
; => "Five test results went terribly wrong!"
|
||||
```
|
||||
At any point, you can bind the `*enabled*` special variable to `nil`, and anything inside that binding will not be printed colorfully:
|
||||
```lisp
|
||||
* (let (cl-ansi-text:*enabled*)
|
||||
(princ (red "This string is printed normally")))
|
||||
```
|
||||
|
||||
# API
|
||||
|
||||
|
||||
## BLUE
|
||||
|
||||
Returns a string with the `blue'string denotation preppended and the `reset' string denotation appended.
|
||||
|
||||
*enabled* dynamically controls the function.
|
||||
|
||||
## MAGENTA
|
||||
|
||||
Returns a string with the `magenta'string denotation preppended and the `reset' string denotation appended.
|
||||
|
||||
*enabled* dynamically controls the function.
|
||||
|
||||
## CYAN
|
||||
|
||||
Returns a string with the `cyan'string denotation preppended and the `reset' string denotation appended.
|
||||
|
||||
*enabled* dynamically controls the function.
|
||||
|
||||
## GREEN
|
||||
|
||||
Returns a string with the `green'string denotation preppended and the `reset' string denotation appended.
|
||||
|
||||
*enabled* dynamically controls the function.
|
||||
|
||||
## WITH-COLOR
|
||||
|
||||
Writes out the string denoting a switch to `color`, executes body,
|
||||
then writes out the string denoting a `reset`.
|
||||
|
||||
*enabled* dynamically controls expansion..
|
||||
|
||||
## YELLOW
|
||||
|
||||
Returns a string with the `yellow'string denotation preppended and the `reset' string denotation appended.
|
||||
|
||||
*enabled* dynamically controls the function.
|
||||
|
||||
## BLACK
|
||||
|
||||
Returns a string with the `black'string denotation preppended and the `reset' string denotation appended.
|
||||
|
||||
*enabled* dynamically controls the function.
|
||||
|
||||
## *ENABLED*
|
||||
|
||||
Turns on/off the colorization of functions
|
||||
|
||||
## MAKE-COLOR-STRING
|
||||
|
||||
Takes either a cl-color or a list denoting the ANSI colors and
|
||||
returns a string sufficient to change to the given color.
|
||||
|
||||
Will be dynamically controlled by *enabled* unless manually specified
|
||||
otherwise
|
||||
|
||||
## RED
|
||||
|
||||
Returns a string with the `red'string denotation preppended and the `reset' string denotation appended.
|
||||
|
||||
*enabled* dynamically controls the function.
|
||||
|
||||
## WHITE
|
||||
|
||||
Returns a string with the `white'string denotation preppended and the `reset' string denotation appended.
|
||||
|
||||
*enabled* dynamically controls the function.
|
||||
|
||||
## +RESET-COLOR-STRING+
|
||||
|
||||
This string will reset ANSI colors
|
||||
|
||||
|
||||
# Note
|
||||
|
||||
Note that your terminal MUST be ANSI-compliant to show these
|
||||
colors. My SLIME REPL (as of Feb 2013) does not display these
|
||||
colors. I have to use a typical Linux/OSX terminal to see them.
|
||||
|
||||
This has been tested to work on a Linux system with SBCL, CLISP and
|
||||
CCL. CCL may not work quite perfectly, some level of conniptions were
|
||||
encountered in testing. The interested reader is advised to check the
|
||||
MAKE-LOAD-FORM defmethod in cl-ansi-text.lisp.
|
||||
|
||||
An earlier variant was tested on OSX 10.6 with SBCL.
|
||||
|
||||
License: LLGPL
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
#!/bin/bash
|
||||
error=0
|
||||
if which sbcl; then
|
||||
echo "CI run using SBCL"
|
||||
sbcl --script run-tests.lisp
|
||||
error=$?
|
||||
fi
|
||||
|
||||
if which lx86cl64; then
|
||||
echo "CI run using CCL"
|
||||
lx86cl64 -b --load run-tests.lisp
|
||||
error=$(($error+$?))
|
||||
fi
|
||||
|
||||
exit $error
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
(asdf:defsystem #:cl-ansi-text-test
|
||||
:depends-on ( #:cl-colors #:alexandria #:cl-ansi-text #:fiveam)
|
||||
:components ((:module "test"
|
||||
:components
|
||||
((:file "cl-ansi-text-test"))))
|
||||
:name "cl-ansi-text-test"
|
||||
:version "1.0"
|
||||
:maintainer "Paul Nathan"
|
||||
:author "Paul Nathan"
|
||||
:licence "LLGPL"
|
||||
:description "Test system for cl-ansi-text")
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
(asdf:defsystem #:cl-ansi-text
|
||||
:depends-on ( #:cl-colors #:alexandria)
|
||||
:components ((:file "cl-ansi-text"))
|
||||
:name "cl-ansi-text"
|
||||
:version "1.0"
|
||||
:maintainer "Paul Nathan"
|
||||
:author "Paul Nathan"
|
||||
:licence "LLGPL"
|
||||
:description "ANSI control string characters, focused on color"
|
||||
:long-description "ANSI control string management, specializing in
|
||||
colors. Sometimes it is nice to have text output in colors")
|
||||
|
|
@ -0,0 +1,285 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;; Paul Nathan 2013
|
||||
;;;; cl-ansi-text.lisp
|
||||
;;;;
|
||||
;;;; Portions of this code were written by taksatou under the
|
||||
;;;; cl-rainbow name.
|
||||
;;;;
|
||||
;;;; A library to produce ANSI escape sequences. Particularly,
|
||||
;;;; produces colorized text on terminals
|
||||
|
||||
(defpackage :cl-ansi-text
|
||||
(:use :common-lisp)
|
||||
(:export
|
||||
#:with-color
|
||||
#:make-color-string
|
||||
#:+reset-color-string+
|
||||
#:*enabled*
|
||||
#:black
|
||||
#:red
|
||||
#:green
|
||||
#:yellow
|
||||
#:blue
|
||||
#:magenta
|
||||
#:cyan
|
||||
#:white))
|
||||
(in-package :cl-ansi-text)
|
||||
|
||||
;;; !!! NOTE TO CCL USERS !!!
|
||||
;;;
|
||||
;;; This seems to be *required* to make this compile in CCL. The
|
||||
;;; reason is that CCL expects to be able to inline on compile, but
|
||||
;;; structs don't set up that infrastructure by default.
|
||||
;;;
|
||||
;;; At least from the thread "Compiler problem, MCL 3.9" by Arthur
|
||||
;;; Cater around '96.
|
||||
#+ccl(common-lisp:eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(defmethod make-load-form ((obj cl-colors:rgb ) &optional env)
|
||||
(make-load-form-saving-slots obj)))
|
||||
|
||||
(defparameter *enabled* t
|
||||
"Turns on/off the colorization of functions")
|
||||
|
||||
(defparameter +reset-color-string+
|
||||
(concatenate 'string (list (code-char 27) #\[ #\0 #\m))
|
||||
"This string will reset ANSI colors")
|
||||
|
||||
(defvar +cl-colors+
|
||||
(vector
|
||||
cl-colors:+black+
|
||||
cl-colors:+red+
|
||||
cl-colors:+green+
|
||||
cl-colors:+yellow+
|
||||
cl-colors:+blue+
|
||||
cl-colors:+magenta+
|
||||
cl-colors:+cyan+
|
||||
cl-colors:+white+)
|
||||
"CL-COLORS colors")
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(defparameter +term-colors+
|
||||
(vector
|
||||
:black
|
||||
:red
|
||||
:green
|
||||
:yellow
|
||||
:blue
|
||||
:magenta
|
||||
:cyan
|
||||
:white)
|
||||
"Basic colors"))
|
||||
|
||||
(defparameter +text-style+
|
||||
'((:foreground . 30)
|
||||
(:background . 40))
|
||||
"One or the other. Not an ANSI effect")
|
||||
|
||||
(defparameter +term-effects+
|
||||
'((:unset . t)
|
||||
(:reset . 0)
|
||||
(:bright . 1)
|
||||
(:italic . 3)
|
||||
(:underline . 4)
|
||||
(:blink . 5)
|
||||
(:inverse . 7)
|
||||
(:hide . 8)
|
||||
(:normal . 22)
|
||||
(:framed . 51)
|
||||
(:encircled . 52)
|
||||
(:overlined . 53)
|
||||
(:not-framed-or-circled . 54)
|
||||
(:not-overlined . 55))
|
||||
"ANSI terminal effects")
|
||||
|
||||
(defun eq-colors (a b)
|
||||
"Equality for cl-colors"
|
||||
|
||||
;; CL-COLORS LIB!
|
||||
|
||||
;; eql, equal doesn't quite work for compiled cl-colors on CCL
|
||||
(and
|
||||
(= (cl-colors:rgb-red a)
|
||||
(cl-colors:rgb-red b))
|
||||
(= (cl-colors:rgb-green a)
|
||||
(cl-colors:rgb-green b))
|
||||
(= (cl-colors:rgb-blue a)
|
||||
(cl-colors:rgb-blue b))))
|
||||
|
||||
(defun cl-colors-to-ansi (color)
|
||||
(position color +cl-colors+ :test #'eq-colors))
|
||||
|
||||
(defun term-colors-to-ansi (color)
|
||||
(position color +term-colors+))
|
||||
|
||||
|
||||
|
||||
;; Find-X-code is the top-level interface for code-finding
|
||||
|
||||
(defun find-color-code (color)
|
||||
"Find the list denoting the color"
|
||||
(typecase color
|
||||
;; Did we get a cl-color that we know about?
|
||||
(cl-colors:rgb (cl-colors-to-ansi color))
|
||||
(symbol (term-colors-to-ansi color))))
|
||||
|
||||
(defun find-effect-code (effect)
|
||||
"Returns the number for the text effect OR
|
||||
t if no effect should be used OR
|
||||
nil if the effect is unknown.
|
||||
|
||||
effect should be a member of +term-effects+"
|
||||
(cdr (assoc effect +term-effects+)))
|
||||
|
||||
(defun find-style-code (style)
|
||||
(cdr (assoc style +text-style+)))
|
||||
|
||||
(defun rgb-code-p (color)
|
||||
(typecase color
|
||||
(list t)
|
||||
(integer t)))
|
||||
|
||||
(defun generate-control-string (code)
|
||||
"General ANSI code"
|
||||
(format nil "~c[~a" (code-char #o33) code))
|
||||
|
||||
(defun generate-color-string (code)
|
||||
;; m is the action character for color
|
||||
(format nil "~am" (generate-control-string code)))
|
||||
|
||||
(defun build-control-string (color
|
||||
&optional
|
||||
(effect :unset)
|
||||
(style :foreground))
|
||||
"Color (cl-color or term-color)
|
||||
Effect
|
||||
Style"
|
||||
(let ((effect-code (find-effect-code effect))
|
||||
(color-code (find-color-code color))
|
||||
(style-code (find-style-code style)))
|
||||
|
||||
;; Nil here indicates an error
|
||||
(assert effect-code)
|
||||
(assert style-code)
|
||||
|
||||
;; Returns a list for inspection; next layer turns it back into a
|
||||
;; string.
|
||||
(concatenate
|
||||
'list
|
||||
;; We split between RGB and 32-color here; this preserves the
|
||||
;; interface without cluttering the 32-color code up.
|
||||
;;
|
||||
(let ((codes nil))
|
||||
(unless (eq effect-code t)
|
||||
(setf codes (cons effect-code codes)))
|
||||
(if (rgb-code-p color)
|
||||
(setf codes (cons (rgb-color-code color style) codes))
|
||||
(setf codes (cons (+ style-code color-code) codes)))
|
||||
|
||||
(generate-color-string (format nil "~{~A~^;~}" codes))))))
|
||||
|
||||
;; Public callables.
|
||||
|
||||
(defun make-color-string (color &key
|
||||
(effect :unset)
|
||||
(style :foreground)
|
||||
((enabled *enabled*) *enabled*))
|
||||
"Takes either a cl-color or a list denoting the ANSI colors and
|
||||
returns a string sufficient to change to the given color.
|
||||
|
||||
Will be dynamically controlled by *enabled* unless manually specified
|
||||
otherwise"
|
||||
(when *enabled*
|
||||
(concatenate 'string
|
||||
(build-control-string color effect style))))
|
||||
|
||||
(defmacro with-color ((color &key
|
||||
(stream t)
|
||||
(effect :unset)
|
||||
(style :foreground))
|
||||
&body body)
|
||||
"Writes out the string denoting a switch to `color`, executes body,
|
||||
then writes out the string denoting a `reset`.
|
||||
|
||||
*enabled* dynamically controls expansion.."
|
||||
`(progn
|
||||
(when *enabled*
|
||||
(format ,stream "~a" (make-color-string ,color
|
||||
:effect ,effect
|
||||
:style ,style)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
,@body)
|
||||
(when *enabled*
|
||||
(format ,stream "~a" +reset-color-string+)))))
|
||||
|
||||
(defmacro gen-color-functions (color-names-vector)
|
||||
`(progn
|
||||
,@(map 'list
|
||||
(lambda (color)
|
||||
`(defun ,(intern (symbol-name color)) (string &key
|
||||
(effect :unset)
|
||||
(style :foreground))
|
||||
,(concatenate
|
||||
'string
|
||||
"Returns a string with the `" (string-downcase color)
|
||||
"'string denotation preppended and the `reset' string denotation appended.
|
||||
|
||||
*enabled* dynamically controls the function." )
|
||||
(concatenate
|
||||
'string
|
||||
(when *enabled*
|
||||
(format nil "~a" (make-color-string ,color
|
||||
:effect effect
|
||||
:style style)))
|
||||
string
|
||||
(when *enabled*
|
||||
(format nil "~a" +reset-color-string+)))))
|
||||
color-names-vector)))
|
||||
|
||||
(gen-color-functions #.(coerce +term-colors+ 'list))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; RGB color codes for some enhanced terminals
|
||||
|
||||
;;; http://www.frexx.de/xterm-256-notes/
|
||||
(defun rgb-to-ansi (red green blue)
|
||||
(let ((ansi-domain (mapcar #'(lambda (x)
|
||||
(floor (* 6 (/ x 256.0))))
|
||||
(list red green blue))))
|
||||
(+ 16
|
||||
(* 36 (first ansi-domain))
|
||||
(* 6 (second ansi-domain))
|
||||
(third ansi-domain))))
|
||||
|
||||
(defun code-from-rgb (style red green blue)
|
||||
(format nil "~d;5;~d"
|
||||
(if (eql style :foreground) 38 48)
|
||||
(rgb-to-ansi red green blue)))
|
||||
|
||||
|
||||
(defgeneric rgb-color-code (color &optional style)
|
||||
(:documentation
|
||||
"Returns the 256-color code suitable for rendering on the Linux
|
||||
extensions to xterm"))
|
||||
|
||||
(defmethod rgb-color-code ((color list) &optional (style :foreground))
|
||||
(unless (consp color)
|
||||
(error "~a must be a three-integer list" color))
|
||||
|
||||
(unless (and (integerp (first color))
|
||||
(integerp (second color))
|
||||
(integerp (second color)))
|
||||
(error "~a must have three integers" color))
|
||||
|
||||
(code-from-rgb style
|
||||
(first color)
|
||||
(second color)
|
||||
(third color)))
|
||||
|
||||
(defmethod rgb-color-code ((color integer) &optional (style :foreground))
|
||||
;; Takes RGB integer ala Web integers
|
||||
(code-from-rgb style
|
||||
;; classic bitmask
|
||||
(ash (logand color #xff0000) -16)
|
||||
(ash (logand color #x00ff00) -8)
|
||||
(logand color #x0000ff)))
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
#-quicklisp
|
||||
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
|
||||
(user-homedir-pathname))))
|
||||
(when (probe-file quicklisp-init)
|
||||
(load quicklisp-init)))
|
||||
|
||||
#+sbcl(require "sb-posix")
|
||||
|
||||
(defparameter *pwd*
|
||||
(concatenate 'string
|
||||
(progn #+sbcl(sb-posix:getcwd)
|
||||
#+ccl(ccl::current-directory-name))
|
||||
"/"))
|
||||
|
||||
(push *pwd* asdf:*central-registry*)
|
||||
|
||||
|
||||
(ql:quickload '(:cl-colors
|
||||
:alexandria
|
||||
:fiveam
|
||||
|
||||
:cl-ansi-text
|
||||
:cl-ansi-text-test))
|
||||
|
||||
(let ((result-status (cl-ansi-text-test::ci-run)))
|
||||
(let ((posix-status
|
||||
(if result-status 0 1)))
|
||||
#+sbcl(sb-posix:exit posix-status)
|
||||
#+ccl (quit posix-status)))
|
||||
|
|
@ -0,0 +1,123 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; test suite for cl-ansi-text
|
||||
|
||||
(defpackage :cl-ansi-text-test
|
||||
(:use :common-lisp
|
||||
:cl-user
|
||||
:cl-ansi-text
|
||||
:fiveam))
|
||||
|
||||
(in-package :cl-ansi-text-test)
|
||||
(use-package :fiveam)
|
||||
(use-package :cl-ansi-text)
|
||||
|
||||
(def-suite test-suite
|
||||
:description "test suite.")
|
||||
|
||||
(in-suite test-suite)
|
||||
|
||||
|
||||
(test basic-color-strings
|
||||
"Test the basic stuff"
|
||||
(is (equal '(#\Esc #\[ #\3 #\1 #\m)
|
||||
(cl-ansi-text::build-control-string :red :unset :foreground)))
|
||||
(is (equal '(#\Esc #\[ #\4 #\1 #\m)
|
||||
(cl-ansi-text::build-control-string :red :unset :background)))
|
||||
(is (equal '(#\Esc #\[ #\4 #\2 #\; #\1 #\m)
|
||||
(cl-ansi-text::build-control-string :green :bright :background))))
|
||||
|
||||
(test enabled-connectivity
|
||||
"Test *enabled*'s capability"
|
||||
(is (equal '(#\Esc #\[ #\3 #\1 #\m)
|
||||
(let ((*enabled* t))
|
||||
(concatenate
|
||||
'list
|
||||
(cl-ansi-text:make-color-string :red)))))
|
||||
(is (equal '()
|
||||
(let ((*enabled* nil))
|
||||
(concatenate
|
||||
'list
|
||||
(cl-ansi-text:make-color-string :red)))))
|
||||
(is (equal "hi"
|
||||
(let ((*enabled* nil))
|
||||
(with-output-to-string (s)
|
||||
(with-color (:red :stream s) (format s "hi"))))))
|
||||
(is (equal '(#\Esc #\[ #\3 #\1 #\m #\T #\e #\s #\t #\! #\Esc #\[ #\0 #\m)
|
||||
(concatenate
|
||||
'list
|
||||
(with-output-to-string (s)
|
||||
(with-color (:red :stream s)
|
||||
(format s "Test!")))))))
|
||||
|
||||
(test rgb-suite
|
||||
"Test RGB colors"
|
||||
(is (equal '(#\Esc #\[ #\3 #\8 #\; #\5 #\; #\2 #\1 #\4 #\m)
|
||||
(cl-ansi-text::build-control-string #xFFAA00
|
||||
:unset :foreground)))
|
||||
(is (equal '(#\Esc #\[ #\4 #\8 #\; #\5 #\; #\2 #\1 #\4 #\m)
|
||||
(cl-ansi-text::build-control-string #xFFAA00
|
||||
:unset :background)))
|
||||
(is (equal '(#\Esc #\[ #\4 #\8 #\; #\5 #\; #\1 #\6 #\m)
|
||||
(cl-ansi-text::build-control-string #x000000
|
||||
:unset :background)))
|
||||
(is (equal '(#\Esc #\[ #\4 #\8 #\; #\5 #\; #\2 #\3 #\1 #\m)
|
||||
(cl-ansi-text::build-control-string #xFFFFFF
|
||||
:unset :background))))
|
||||
|
||||
(test color-named-functions
|
||||
(let ((str "Test string."))
|
||||
(is (equal (black str)
|
||||
(with-output-to-string (s)
|
||||
(with-color (:black :stream s)
|
||||
(format s str)))))
|
||||
(is (equal (red str)
|
||||
(with-output-to-string (s)
|
||||
(with-color (:red :stream s)
|
||||
(format s str)))))
|
||||
|
||||
(is (equal (green str)
|
||||
(with-output-to-string (s)
|
||||
(with-color (:green :stream s)
|
||||
(format s str)))))
|
||||
|
||||
(is (equal (yellow str)
|
||||
(with-output-to-string (s)
|
||||
(with-color (:yellow :stream s)
|
||||
(format s str)))))
|
||||
(is (equal (blue str)
|
||||
(with-output-to-string (s)
|
||||
(with-color (:blue :stream s)
|
||||
(format s str)))))
|
||||
(is (equal (magenta str)
|
||||
(with-output-to-string (s)
|
||||
(with-color (:magenta :stream s)
|
||||
(format s str)))))
|
||||
(is (equal (cyan str)
|
||||
(with-output-to-string (s)
|
||||
(with-color (:cyan :stream s)
|
||||
(format s str)))))
|
||||
(is (equal (white str)
|
||||
(with-output-to-string (s)
|
||||
(with-color (:white :stream s)
|
||||
(format s str)))))))
|
||||
|
||||
(test color-named-functions-*enabled*
|
||||
(let ((str "Other test string.")
|
||||
(*enabled* nil))
|
||||
(is
|
||||
(equal str
|
||||
(white (cyan (magenta (blue (yellow (green (red (black str))))))))))))
|
||||
|
||||
(defun run-tests ()
|
||||
(let ((results (run 'test-suite)))
|
||||
(explain! results)
|
||||
(if (position-if #'(lambda (e)
|
||||
(eq (type-of e)
|
||||
'IT.BESE.FIVEAM::TEST-FAILURE
|
||||
))
|
||||
results)
|
||||
nil
|
||||
t)))
|
||||
|
||||
(defun ci-run ()
|
||||
(run-tests))
|
||||
Loading…
Add table
Add a link
Reference in a new issue