scx/scheme/xlib/helper.scm

;; 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 "*symbol-now*" 'now)


;; 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))))