55 lines
1.4 KiB
Scheme
55 lines
1.4 KiB
Scheme
;; 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)))) |