[MIT-Scheme-devel] Legacy bugs.

[Patric Jonsson]

;;; 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))