2001-06-11 11:28:32 -04:00
|
|
|
;; 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)))))))
|
|
|
|
|
|
|
|
|
2001-06-25 07:46:06 -04:00
|
|
|
(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)))
|
|
|
|
(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))))))
|
|
|
|
|
|
|
|
;; according to the XLib constant "Null" which is defined as "0L"
|
|
|
|
|
|
|
|
(define null-resource? zero?)
|
|
|
|
(define null-resource 0)
|