+ added function to read/write properties of type WINDOW.

c/xlib/property.c

@@ -57,32 +57,29 @@ s48_value scx_Get_Property(s48_value Xwindow, s48_value Xdisplay,
   Atom actual_type_ret;
   int format_ret, i;
   unsigned long nitems_ret, bytes_left_ret;
-  unsigned char* prop_ret;
+  unsigned char* prop_ret = NULL;
 
   s48_value ret = S48_FALSE, x = S48_FALSE, v = S48_FALSE;
 
   S48_DECLARE_GC_PROTECT(3);
 
   //not used: Disable_Interrupts
-  XGetWindowProperty (SCX_EXTRACT_DISPLAY(Xdisplay), 
+  if (XGetWindowProperty (SCX_EXTRACT_DISPLAY(Xdisplay), 
 			  SCX_EXTRACT_WINDOW(Xwindow),
 			  s48_extract_integer(Xatom_prop), 
 			  s48_extract_integer (start),
-		      s48_extract_integer (len), S48_EXTRACT_BOOLEAN(deletep), 
+			  s48_extract_integer (len),
+			  S48_EXTRACT_BOOLEAN(deletep), 
 			  req_type, &actual_type_ret, &format_ret, &nitems_ret,
-		      &bytes_left_ret, &prop_ret);
+			  &bytes_left_ret, &prop_ret) == Success) {
 
-  if (actual_type_ret == None) {
-    // Property does not exists
-    ret = S48_FALSE;
-  } else {
     // Create the data as a vector
     S48_GC_PROTECT_3 (ret, v, x);
 
     v = s48_make_vector(nitems_ret, S48_FALSE);
     for (i = 0; i < nitems_ret; i++) {
       switch (format_ret) {
-      case 8: x = s48_enter_fixnum(((char*) prop_ret)[i]); break;
+      case 8: x = s48_enter_fixnum(((unsigned char*) prop_ret)[i]); break;
       case 16: x = s48_enter_fixnum(((short*) prop_ret)[i]); break;
       case 32: x = s48_enter_integer(((long*) prop_ret)[i]); break;
       }
@@ -95,9 +92,14 @@ s48_value scx_Get_Property(s48_value Xwindow, s48_value Xdisplay,
     ret = s48_cons(SCX_ENTER_ATOM(actual_type_ret), ret);
 
     S48_GC_UNPROTECT();
-    XFree(prop_ret); // only if property exists??
+  } else {
+    // Property does not exists
+    ret = S48_FALSE;
   }
 
+  if (prop_ret != NULL)
+    XFree(prop_ret);
+
   return ret;
 }
 

scheme/xlib/property.scm

@@ -29,13 +29,13 @@
 (import-lambda-definition %list-properties (Xdisplay Xwindow)
   "scx_List_Properties")
 
-;; get-window-property returns a list of four elements (atom format
+;; get-property-extended returns a list of four elements (atom format
 ;; data bytes-left) on success. format is one of 8, 16 or 32. #f is
 ;; returned if no such property of the requested type exists.
 ;; request-type can be #f, which means that the property can be of any
 ;; type. See XGetWindowProperty for offset, length and delete?.
 
-(define (get-window-property window atom request-type offset length delete?)
+(define (get-property-extended window atom request-type offset length delete?)
   (let ((type.format.data.bytes-left
 	 (%get-property (window-Xwindow window)
 			(display-Xdisplay (window-display window))
@@ -54,13 +54,13 @@
    "scx_Get_Property")
 
 ;; get-property is a an easier way to access a property. It uses
-;; get-window-property to read the whole property into a vector. It
+;; get-property-extended to read the whole property into a vector. It
 ;; returns a list of three elements the vector, type-atom and the
 ;; format.
 
 (define (get-property window atom delete?)
   (let loop ((i 5))
-    (let ((t.f.d.b (get-window-property window atom #f 0 i delete?)))
+    (let ((t.f.d.b (get-property-extended window atom #f 0 i delete?)))
       (if (not t.f.d.b)
 	  #f
 	  (if (= (cadddr t.f.d.b) 0)
@@ -96,6 +96,19 @@
 					     (string (car chars)))
 		  rev-res)))))))
 
+;; get-window-property reads the specified property of type WINDOW.
+
+(define (get-window-property window atom delete?)
+  (let ((dpy (window-display window))
+	(v.t.f (get-property window atom delete?)))
+    (if (or (not v.t.f) (not (eq? (intern-atom dpy "WINDOW")
+				  (cadr v.t.f)))
+	    (not (= 32 (caddr v.t.f))))
+	#f ;; error message?
+	(map (lambda (Xwindow)
+	       (make-window Xwindow dpy #f))
+	     (vector->list (car v.t.f))))))
+
 ;; change-property alters the property for the specified
 ;; window. property and type have to atoms, format has to be one of 8,
 ;; 16, 32, mode has to be a change-property-mode which defaults to
@@ -148,6 +161,8 @@
 					   (list str/str-list)))))))
     (apply change-property window property type 8 vec maybe-mode)))
 
+;; change-window-property sets
+
 ;; See XDeleteProperty
 
 (define (delete-property window property)