scsh-conservatory
/
scx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

This commit is contained in:
frese 2002-04-02 11:36:34 +00:00
parent a72df4abd5
commit 1bf411918c
2 changed files with 35 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
c/xlib/property.c
View File

@ -57,32 +57,29 @@ s48_value scx_Get_Property(s48_value Xwindow, s48_value Xdisplay,
Atom actual_type_ret; Atom actual_type_ret;
int format_ret, i; int format_ret, i;
unsigned long nitems_ret, bytes_left_ret; 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_value ret = S48_FALSE, x = S48_FALSE, v = S48_FALSE;
S48_DECLARE_GC_PROTECT(3); S48_DECLARE_GC_PROTECT(3);
//not used: Disable_Interrupts //not used: Disable_Interrupts
XGetWindowProperty (SCX_EXTRACT_DISPLAY(Xdisplay), if (XGetWindowProperty (SCX_EXTRACT_DISPLAY(Xdisplay),
SCX_EXTRACT_WINDOW(Xwindow), SCX_EXTRACT_WINDOW(Xwindow),
s48_extract_integer(Xatom_prop), s48_extract_integer(Xatom_prop),
s48_extract_integer (start), s48_extract_integer (start),
s48_extract_integer (len), S48_EXTRACT_BOOLEAN(deletep), s48_extract_integer (len),
req_type, &actual_type_ret, &format_ret, &nitems_ret, S48_EXTRACT_BOOLEAN(deletep),
&bytes_left_ret, &prop_ret); req_type, &actual_type_ret, &format_ret, &nitems_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 // Create the data as a vector
S48_GC_PROTECT_3 (ret, v, x); S48_GC_PROTECT_3 (ret, v, x);
v = s48_make_vector(nitems_ret, S48_FALSE); v = s48_make_vector(nitems_ret, S48_FALSE);
for (i = 0; i < nitems_ret; i++) { for (i = 0; i < nitems_ret; i++) {
switch (format_ret) { 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 16: x = s48_enter_fixnum(((short*) prop_ret)[i]); break;
case 32: x = s48_enter_integer(((long*) 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); ret = s48_cons(SCX_ENTER_ATOM(actual_type_ret), ret);
S48_GC_UNPROTECT(); 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; return ret;
} }

23
scheme/xlib/property.scm
View File

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