blob: 00aa91ecdfbfb20f5f5b0c338592c3ea5450715c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
;;; (yolk common) --- common stuff for ansi things
(import (scheme base)
(scheme write))
(define (->string x)
(let ((str (open-output-string)))
(display x str)
(close-output-port str)
(get-output-string str)))
(define (esc . xs)
(apply string-append (string #\escape)
(map ->string xs)))
(define (csi . xs)
(apply esc "[" xs))
(define (dcs . xs)
(apply esc "P" xs))
(define (ocs . xs)
(apply esc "]" xs))
(define-syntax define-esc-alt-wrapper
(syntax-rules ()
((_ wrapper-proc-name param-name (default-proc args ...))
(begin
(define param-name
(make-parameter default-proc
(parameter-assert procedure? "Must be a procedure")))
(define (wrapper-proc-name args ...)
((param-name) args ...))))))
(define (parameter-assert predicate error-message)
(lambda (x)
(if (predicate x)
x
(error error-message x))))
|
