Update of /cvsroot/scsh/scx/scheme/xlib
In directory usw-pr-cvs1:/tmp/cvs-serv18105
Added Files:
helper.scm
Log Message:
renamed - former stuff.scm
--- NEW FILE ---
;; 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))))
|