diff --git a/scheme/xlib/helper.scm b/scheme/xlib/helper.scm new file mode 100644 index 0000000..57841af --- /dev/null +++ b/scheme/xlib/helper.scm @@ -0,0 +1,55 @@ +;; named-args->alist does this: +;; '(a 5 b 6 ((c . 10) (d . 5))) -> '((a . 5) (b . 6) (c . 10) (d . 5)) +;; '(e 3) -> '((e . 3)) +;; '((f . 0)) -> '((f . 0)) +;; (hard to explain :-) + +(define (named-args->alist args) + (let loop ((alist '()) + (args args)) + (cond + ((null? args) (reverse alist)) + ((null? (cdr args)) (loop (append (car args) alist) '())) + (else (let ((sym (car args)) + (val (cadr args))) + (loop (cons (cons sym val) alist) + (cddr args))))))) + + +(define-exported-binding "string->symbol" string->symbol) + + +;; alist-split returns multiple values. the first values are all associations +;; of the keys. and additionaly the "rest" of the alist as one value. + +(define (alist-split alist key-def-list) + (let ((keys (map car key-def-list))) + (let ((vals (map (lambda (key) + (let ((v (assq key alist))) + (cdr (if v v (assq key key-def-list))))) + keys)) + (rest (fold-right (lambda (this rest) + (if (memq (car this) keys) + rest + (cons this rest))) + '() + alist))) + (apply values (append vals (list rest)))))) + +;; compagnion to the XLib constant "None" which is defined as "0L" + +(define (none-resource? obj) + (eq? obj none-resource)) + +(define none-resource 'none) + +;; + +(define (vector-map! f v) + (let ((n (vector-length v))) + (let loop ((i 0)) + (if (< i n) + (begin + (vector-set! v i (f (vector-ref v i))) + (loop (+ i 1))) + v)))) \ No newline at end of file