renamed - former stuff.scm

scheme/xlib/helper.scm

@@ -0,0 +1,55 @@
+;; 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))))