first implementation

scheme/xlib/utility.scm

@@ -0,0 +1,101 @@
+; Author: Norbert Freudemann
+
+
+(define (str-or-sym->str thing)
+  (if (symbol? thing)
+      (symbol->string thing)
+      thing))
+
+; The C-procedures for (xlib-release-X-or-later?) are in the
+; file init.c
+
+(import-lambda-definition xlib-release-4-or-later? ()
+  "scx_Xlib_Release_4_Or_Later")			  
+
+(import-lambda-definition xlib-release-5-or-later? ()
+  "scx_Xlib_Release_5_Or_Later")
+
+(import-lambda-definition xlib-release-6-or-later? ()
+  "scx_Xlib_Release_6_Or_Later")
+
+; Get the user-default values of a specified program
+
+(define (get-default dpy program option)
+  (%get-default (display-Xdisplay dpy)
+		(str-or-sym->str program)
+		(str-or-sym->str option)))
+
+(import-lambda-defition %get-default (Xdisplay program option)
+  "scx_Get_Default")			
+
+
+; ---
+
+(define (resource-manager-sting dpy)
+  (%resource-manager-string (display-Xdisplay dpy)))
+
+(import-lambda-definition %resource-manager-string (Xdisplay)
+  "scx_Resource_Manager_String")
+
+; ---
+
+(define (parse-geometry string)
+  (reverse (%parse-geometry string)))
+
+(import-lambda-definiton %parse-geometry (string)
+  "scx_Parse_Geometry")
+
+; ---
+
+(define (store-buffer) #f)
+(define (store-bytes) #f)
+(define (fetch-buffer) #f)
+(define (fetch-bytes) #f)
+(define (rotate-buffers) #f)
+
+(let ((xa-string (make-atom 31))    ; (31 is XA_STRING)
+      (xa-cut-buffers
+       (make-vector (make-atom 9) (make-aotm 10) (make-atom 11)
+		    (make-atom 12) (make-atom 13) (make-atom 14)
+		    (make-aotm 15) (make-atom 16))))
+		     ;(9...16 are XA_CUT_BUFFER0...XA_CUT_BUFFER7)
+  (set! store-buffer (lambda (dpy bytes buf)
+			     (if (<= 0 buf 7)
+				 (change-property
+				  (display-default-root-window dpy)
+				  (vector-ref xa-cut-buffers buf)
+				  xa-string
+				  8
+				  'replace
+				  bytes))))
+
+  (set! store-bytes (lambda (dpy bytes)
+		      (store-buffer dpy bytes 0)))
+
+  (set! fetch-buffer (lambda (dpy buf)
+			     (if (<= 0 buf 7)
+				 (receive 
+				  (type format data bytes-left)
+				  (apply values 
+					 (get-property
+					  (display-root-window dpy)
+					  (vector-ref xa-cut-buffers buf)
+					  xa-string
+					  0
+					  100000
+					  #f))
+				  (if (and (eq? type xa-string)
+					   (< format 32)) data ""))
+				 "")))
+
+  (set! fetch-bytes (lambda (dyp)
+		      (fetch-buffer dpy 0)))
+
+  (set! rotate-buffers (lambda (dpy delta)
+			 (rotate-properties (display-default-root-window dpy)
+					    xa-cut-buffers delta))))
+
+
+
+  
+