From 9d7832066cd72d35029fd11aa65cb93fad0c6de3 Mon Sep 17 00:00:00 2001
From: nofreude <nofreude>
Date: Fri, 12 Apr 2002 13:55:10 +0000
Subject: [PATCH] Enumerated types for resources and a
 c->scheme-resource-conversion.

---
 scheme/xt/resource-types.scm | 87 ++++++++++++++++++++++++++++++++++++
 1 file changed, 87 insertions(+)
 create mode 100644 scheme/xt/resource-types.scm

diff --git a/scheme/xt/resource-types.scm b/scheme/xt/resource-types.scm
new file mode 100644
index 0000000..f4dc262
--- /dev/null
+++ b/scheme/xt/resource-types.scm
@@ -0,0 +1,87 @@
+;; Some enumerated types for resources. They correspond to the
+;; constants defined in X.h and resource.c  So don't change the order!
+
+(define-enumerated-type Xresource :Xresource
+  Xresource-type?
+  Xresources
+  Xresource-name
+  Xresource-index
+  (Unknown String Callbacklist Float Backing-Store Dimension
+   Translation Position Bitmap Cardinal Accelerators Boolean
+   Colormap Cursor Display Font GContext Fixnum Pixel Pixmap
+   Character Widget Window))
+
+(define (integer->resource-type i)
+  (vector-ref resource-type i))
+
+(define (resource-type->integer name)
+  (resource-type name))
+
+;; resource-conversion from c to scheme:
+
+(define (intern-resource-to-scheme-type ident data)
+  (cond
+   ((= ident 0)        
+    (error "Resource type unknown" intern-resource-to-scheme-type ident))
+   ;; nothing to do for this values:
+   ((or (= ident 1)    
+	(= ident 3)    
+	(= ident 5)    
+	(= ident 7)    
+	(= ident 9)   
+	(= ident 11)   
+	(= ident 17)   
+	(= ident 20)   
+	data)
+   ((= ident 2)        
+    ;;not implemented...
+    (error "not implemented"))
+   ((= ident 4)        
+    (integer->backing-store-type data))
+   ((= ident 6)        
+    ;;n.i.
+    (error "not implemented"))
+   ((or (= ident 8)    
+	(= ident 19))  
+    (make-pixmap (car data) (make-display (cdr data) #f) #f))
+   ((= ident 10)       
+    ;;n.i.
+    (error "not implemented"))
+   ((= ident 12)       
+    (make-colormap (car data) (make-display (cdr data) #f) #f))
+   ((= ident 13)       
+    (make-cursor (car data) (make-display (cdr data) #f) #f))
+   ((= ident 14)       
+    (make-display data #f))
+   ((= ident 15)       
+    (if (car (cdr data))
+	(make-font #f #f (car data) (cdr (cdr data)) #f)
+	(make-font #f (car data) #f (cdr (cdr data)) #f)))
+   ((= ident 16)       
+    (make-gcontext (car data) (make-display (cdr data)) #f) #f)
+   ((= ident 18)       
+    (make-pixel data #f #f))
+   ((= ident 21)       
+    (make-widget data #f))
+   ((= ident 22)       
+    (make-window (car data) (make-display (cdr data) #f) #f))
+   (else
+    (error "no valid resource-type" intern-resouce-to-scheme-type ident)))))
+
+;; -----------------------------------------------------------------------------
+
+
+
+(define-enumerated-type backing-store-type :backing-store-type
+  backing-store-type?
+  backing-stores
+  backing-store-name
+  backing-store-index
+  (NotUseful WhenMapped Always))
+
+
+(define (integer->backing-store-type i)
+  (vector-ref backing-store-type i))
+
+(define (backing-store-type->integer name)
+  (backing-store-type name))
\ No newline at end of file