;;; An old bug in the 64b microcode
(ge '(edwin screen x-screen))
(define xterm (screen-xterm (selected-screen)))
(define xdisplay (x-window-display xterm))
(define (x-atoms->symbols atoms)
(and (vector? atoms)
(vector-map (lambda (atom)
(x-atom->symbol xdisplay atom))
atoms)))
(get-xterm-property xterm '_NET_WM_ALLOWED_ACTIONS 'atom #f)
(pp (x-atoms->symbols (out)))
;(get-xterm-property xterm 'WM_HINTS 'wm_hints #f)
;(get-xterm-property xterm 'WM_NORMAL_HINTS 'wm_size_hints #f)
;;; 32b machine
;Value 17: #(444 445 453 454 446 448 449 450 451 460 461)
#(_net_wm_action_move _net_wm_action_resize
_net_wm_action_fullscreen _net_wm_action_minimize
_net_wm_action_shade _net_wm_action_maximize_horz
_net_wm_action_maximize_vert _net_wm_action_change_desktop
_net_wm_action_close _net_wm_action_above
_net_wm_action_below)
;;; 64b machine
;Value 17: #(444 0 445 0 453 0 454 0 446 0 448)
#(_net_wm_action_move #f _net_wm_action_resize #f
_net_wm_action_fullscreen #f _net_wm_action_minimize #f
_net_wm_action_shade #f _net_wm_action_maximize_horz)
;;; microcode/x11base.c
static SCHEME_OBJECT
char_ptr_to_prop_data_32 (const unsigned char * data, unsigned long nitems)
{
SCHEME_OBJECT result = (allocate_marked_vector (TC_VECTOR, nitems, 1));
unsigned long index;
for (index = 0; (index < nitems); index += 1)
/*
VECTOR_SET (result, index, (ulong_to_integer (((CARD32 *) data)
[index])));
*/
VECTOR_SET (result, index, (ulong_to_integer ((CARD32) ((long *) data)
[index])));
return (result);
}
;;; man XGetWindowProperty
;
; prop_return
; Returns the data in the specified format.
; If the returned format is 8, the returned data is represented as a char
array.
; If the returned format is 16, the returned data is represented as
; a array of short int type and should be cast to that type to obtain the
elements.
; If the returned format is 32, the property data will be stored as an array
of longs
; (which in a 64-bit application will be 64-bit values that are padded in
the upper 4 bytes).
;;; Bug ported to scheme in new x11/x11base.scm (reading the source, methinks
this can't be right)
(define (char-ptr-to-prop-data-32 data length)
(let ((scan (copy-alien data))
(result (make-vector length)))
(let loop ((index 0))
(if (< index length)
(begin
(vector-set! result index (c-> scan "CARD32"))
(alien-byte-increment! scan (c-sizeof "CARD32"))
(loop (1+ index)))))
result))
_______________________________________________
MIT-Scheme-devel mailing list
MIT-Scheme-devel@gnu.org
https://lists.gnu.org/mailman/listinfo/mit-scheme-devel
