79 lines
2.2 KiB
Scheme
79 lines
2.2 KiB
Scheme
;; make-enum-alist->vector creates a function that converts an
|
|
;; association list, that maps from an enumerated type to some values,
|
|
;; into a vector. The vector element i contains #f if the
|
|
;; corresponding element i of the enumerated type was not defined in
|
|
;; the alist, and the value ((converter i) value) otherwise. Be sure
|
|
;; to convert boolean values to something else, if you want to know if
|
|
;; a value was not defined, or defined as #f afterwards.
|
|
|
|
(define (make-enum-alist->vector enum-vector index-fun converter)
|
|
(lambda (alist)
|
|
(let ((res (make-vector (vector-length enum-vector) #f)))
|
|
(for-each (lambda (a)
|
|
(vector-set! res (index-fun (car a))
|
|
a))
|
|
alist)
|
|
(let loop ((i 0))
|
|
(if (< i (vector-length res))
|
|
(begin
|
|
(if (vector-ref res i)
|
|
(vector-set! res i
|
|
((converter i) (cdr (vector-ref res i)))))
|
|
(loop (+ i 1)))))
|
|
res)))
|
|
|
|
;; and the other way round...
|
|
|
|
(define (make-vector->enum-alist enum-vector converter)
|
|
(lambda (vector extra-arg)
|
|
(let loop ((i 0))
|
|
(if (< i (vector-length vector))
|
|
(begin
|
|
(vector-set! vector
|
|
i
|
|
((converter i extra-arg) (vector-ref vector i)))
|
|
(loop (+ i 1)))
|
|
(map cons
|
|
(vector->list enum-vector)
|
|
(vector->list vector))))))
|
|
|
|
;;
|
|
|
|
(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))))
|