## wire-to-value-pith.pkg
#
# Translation from X server network bytestring format
# to internal Mythryl datastructure format.
#
# This package gets wrapped by the exception-reporting
# logic in:
#
# src/lib/x-kit/xclient/src/wire/wire-to-value.pkg #
# Every package reading from the X server needs to call us:
#
# src/lib/x-kit/xclient/src/wire/display-old.pkg# src/lib/x-kit/xclient/src/wire/xsocket-old.pkg# src/lib/x-kit/xclient/src/iccc/atom-old.pkg# src/lib/x-kit/xclient/src/iccc/atom-imp-old.pkg# src/lib/x-kit/xclient/src/iccc/window-property-old.pkg# src/lib/x-kit/xclient/src/window/window-old.pkg# src/lib/x-kit/xclient/src/window/selection-imp-old.pkg# src/lib/x-kit/xclient/src/window/font-imp-old.pkg# src/lib/x-kit/xclient/src/window/draw-types-old.pkg# src/lib/x-kit/xclient/src/window/color-spec.pkg# src/lib/x-kit/xclient/src/window/keymap-imp-old.pkg# src/lib/x-kit/xclient/src/window/cs-pixmap-old.pkg# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib#
# TODO
# events
# decodeKeymapNotify
# replies
# decodeAllocColorCellsReply
# decodeAllocColorPlanesReply
# decodeGetPointerMappingReply
# decodeListExtensionsReply
# decodeQueryExtensionReply
# decodeQueryKeymapReply
stipulate
package w8 = one_byte_unt;
package w8v = vector_of_one_byte_unts;
package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkg package xet = xevent_types; # xevent_types is from src/lib/x-kit/xclient/src/wire/xevent-types.pkg package ts = xserver_timestamp; # xserver_timestamp is from src/lib/x-kit/xclient/src/wire/xserver-timestamp.pkg package xe = xerrors; # xerrors is from src/lib/x-kit/xclient/src/wire/xerrors.pkg package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkgherein
package wire_to_value_pith
: Wire_To_Value
{
Font_Query_Reply = { all_chars_exist: Bool,
char_infos: List(xt::Char_Info),
default_char: Int,
draw_dir: xt::Font_Drawing_Direction,
#
font_ascent: Int,
font_descent: Int,
#
max_bounds: xt::Char_Info,
min_bounds: xt::Char_Info,
#
max_byte1: Int,
min_byte1: Int,
#
min_char: Int,
max_char: Int,
#
properties: List(xt::Font_Prop)
};
trace = xtr::log_if xtr::io_logging 0; # Conditionally write strings to tracing.log or whatever.
stipulate
my (&) = large_unt::bitwise_and;
my (|) = large_unt::bitwise_or;
# infix my & | ;
fun is_set (x, i)
=
(x & large_unt::(<<) (0u1, i)) != 0u0;
fun pad n
=
case (unt::bitwise_and (unt::from_int n, 0u3))
#
0u0 => n;
r => n + (4 - unt::to_int_x r);
esac;
fun get_string (bv, i, n)
=
byte::unpack_string_vector (vector_slice_of_one_byte_unts::make_slice (bv, i, THE n));
get8 = w8::to_large_unt o w8v::get;
fun get_word8 arg = unt::from_large_unt (w8::to_large_unt (w8v::get arg));
fun get_int8 arg = w8::to_int (w8v::get arg);
fun get_signed8 arg = w8::to_int_x (w8v::get arg);
fun get16 (s, i) = pack_big_endian_unt16::get_vec (s, i / 2);
fun get_word16 (s, i) = unt::from_large_unt (get16 (s, i));
fun get_int16 (s, i) = large_unt::to_int (get16 (s, i));
fun get_signed16 (s, i) = large_unt::to_int_x (pack_big_endian_unt16::get_vec_x (s, i / 2));
fun get32 (s, i)
=
one_word_unt::from_large_unt (pack_big_endian_unt1::get_vec (s, i / 4));
fun get_signed32 (s, i)
=
one_word_int::from_multiword_int (large_unt::to_multiword_int (pack_big_endian_unt1::get_vec_x (s, i / 4)));
fun get_word (s, i)
=
unt::from_large_unt (get32 (s, i));
fun get_int (s, i)
=
large_unt::to_int_x (pack_big_endian_unt1::get_vec_x (s, i / 4));
w8vextract
=
vector_slice_of_one_byte_unts::to_vector o vector_slice_of_one_byte_unts::make_slice;
fun wrap_fn name f (s, i)
=
f (s, i)
except
ex = { xlogger::err_trace {. cat ["**** ", name, "(", int::to_string (w8v::length s), ", ", int::to_string i, ")\n"]; };
raise exception ex;
};
get8 = wrap_fn "get8" get8;
get_word8 = wrap_fn "getWord8" get_word8;
get_int8 = wrap_fn "getInt8" get_int8;
get_signed8 = wrap_fn "getSigned8" get_signed8;
get16 = wrap_fn "get16" get16;
get_word16 = wrap_fn "getWord16" get_word16;
get_int16 = wrap_fn "getInt16" get_int16;
get_signed16 = wrap_fn "getSigned16" get_signed16;
get32 = wrap_fn "get32" get32;
get_signed32 = wrap_fn "getSigned32" get_signed32;
get_word = wrap_fn "getWord" get_word;
get_int = wrap_fn "getInt" get_int;
fun get_list (f, size: Int) (buf, i, n)
=
{
trace {. "wire-to-value-pith.pkg: decode_connect_request_reply: get_list/TOP"; }; result =
get (i, n, []);
trace {. "wire-to-value-pith.pkg: decode_connect_request_reply: get_list/BOT"; }; result;
}
where
fun get (_, 0, l) => list::reverse l;
get (i, n, l) => get (i+size, n - 1, f (buf, i) ! l);
end;
end;
# Get a list of strings, where each string is preceded by a one-byte length
# field.
#
fun get_string_list (buf, i, n)
=
get (i, n, [])
where
fun get (_, 0, l)
=>
list::reverse l;
get (i, n, l)
=>
{ len = get_int8 (buf, i);
j = i+1;
get (j+len, n - 1, get_string (buf, j, len) ! l);
};
end;
end;
get_xatom = xt::XATOM o get_word;
fun get_xatom_option arg
=
case (get_word arg)
#
0u0 => NULL;
x => THE (xt::XATOM x);
esac;
fun get_xid arg
=
xt::xid_from_unt (get_word arg);
fun get_xid_option arg
=
case (get_word arg)
#
0u0 => NULL;
x => THE (xt::xid_from_unt x);
esac;
get_event_mask = xt::EVENT_MASK o get_word;
get_visual_id = xt::VISUAL_ID o get_word;
fun get_visual_id_option arg
=
case (get_word arg)
#
0u0 => NULL;
x => THE (xt::VISUAL_ID x);
esac;
get_rgb8 = rgb8::rgb8_from_int o get_int;
# Are time values signed??? XXX BUGGO FIXME (X server timestamp values wrap around every 49.7 days)
fun get_xs_timestamp (s, i)
=
ts::XSERVER_TIMESTAMP (get32 (s, i));
fun get_xt_timestamp (s, i)
=
case (get32 (s, i))
#
0u0 => xt::CURRENT_TIME;
t => xt::TIMESTAMP (ts::XSERVER_TIMESTAMP t);
esac;
fun get_bool arg
=
case (w8v::get arg)
#
0u0 => FALSE;
_ => TRUE;
esac;
fun get_pt (s, i)
=
{ col => get_signed16 (s, i),
row => get_signed16 (s, i+2)
};
fun get_size (s, i)
=
{ wide => get_int16 (s, i),
high => get_int16 (s, i+2)
};
fun get_box (s, i)
=
{ col => get_signed16 (s, i),
row => get_signed16 (s, i+2),
#
wide => get_int16 (s, i+4),
high => get_int16 (s, i+6)
};
fun get_wgeom (s, i)
=
{ upperleft => get_pt (s, i ),
size => get_size (s, i+4),
border_thickness => get_int16 (s, i+8)
}
: g2d::Window_Site;
get_key_code = xt::KEYCODE o get_int8;
fun get_stk_pos arg
=
case (w8v::get arg)
#
0u0 => xt::PLACE_ON_TOP;
_ => xt::PLACE_ON_BOTTOM;
esac;
fun get_focus_mode (s, i)
=
case (w8v::get (s, i))
#
0u0 => xt::FOCUS_NORMAL;
0u1 => xt::FOCUS_GRAB;
0u2 => xt::FOCUS_UNGRAB;
0u3 => xt::FOCUS_WHILE_GRABBED;
_ => xgripe::impossible "bad focus mode";
esac;
fun get_focus_detail (s, i)
=
case (w8v::get (s, i))
#
0u0 => xt::FOCUS_ANCESTOR;
0u1 => xt::FOCUS_VIRTUAL;
0u2 => xt::FOCUS_INFERIOR;
0u3 => xt::FOCUS_NONLINEAR;
0u4 => xt::FOCUS_NONLINEAR_VIRTUAL;
0u5 => xt::FOCUS_POINTER;
0u6 => xt::FOCUS_POINTER_ROOT;
0u7 => xt::FOCUS_NONE;
_ => xgripe::impossible "bad focus detail";
esac;
fun get_key_but_set (s, i)
=
{ m = get_word16 (s, i);
( xt::MKSTATE (unt::bitwise_and (m, 0uxFF)),
xt::MOUSEBUTTON_STATE (unt::bitwise_and (m, 0ux1F00))
);
};
fun get_rgb (buf, i)
=
{ red = get_word16 (buf, i );
green = get_word16 (buf, i+2);
blue = get_word16 (buf, i+4);
#
rgb::rgb_from_unts (red, green, blue);
};
fun get_bs (buf, i)
=
case (w8v::get (buf, i))
#
0u0 => xt::BS_NOT_USEFUL;
0u1 => xt::BS_WHEN_MAPPED;
_ => xt::BS_ALWAYS;
esac;
fun get_font_dir (buf, i)
=
case (w8v::get (buf, i))
#
0u0 => xt::DRAW_FONT_LEFT_TO_RIGHT;
0u1 => xt::DRAW_FONT_RIGHT_TO_LEFT;
_ => xgripe::impossible "bad font direction";
esac;
get_xid_list = get_list (get_xid, 4);
get_xatom_list = get_list (get_xatom, 4);
stipulate
fun to_gravity (0u1: one_byte_unt::Unt) => THE xt::NORTHWEST_GRAVITY;
to_gravity 0u2 => THE xt::NORTH_GRAVITY;
to_gravity 0u3 => THE xt::NORTHEAST_GRAVITY;
to_gravity 0u4 => THE xt::WEST_GRAVITY;
to_gravity 0u5 => THE xt::CENTER_GRAVITY;
to_gravity 0u6 => THE xt::EAST_GRAVITY;
to_gravity 0u7 => THE xt::SOUTHWEST_GRAVITY;
to_gravity 0u8 => THE xt::SOUTH_GRAVITY;
to_gravity 0u9 => THE xt::SOUTHEAST_GRAVITY;
to_gravity 0u10 => THE xt::STATIC_GRAVITY;
to_gravity _ => NULL;
end;
herein
fun get_bit_gravity arg
=
case (to_gravity (w8v::get arg))
#
NULL => xt::FORGET_GRAVITY;
THE g => g;
esac;
fun get_window_gravity arg
=
case (to_gravity (w8v::get arg))
#
NULL => xt::UNMAP_GRAVITY;
THE g => g;
esac;
end;
fun get_raw_format arg
=
case (w8v::get arg)
#
0u8 => xt::RAW08;
0u16 => xt::RAW16;
0u32 => xt::RAW32;
_ => xgripe::impossible "[getRawFormat: bad ClientMessage]";
esac;
herein
# Get the reply from a connection request:
#
stipulate
prefix_size = 8;
fun get_order (buf, i)
=
case (get8 (buf, i))
#
0u0 => xt::LSBFIRST;
_ => xt::MSBFIRST;
esac;
fun get_pixmap_format (buf, i)
=
xt::FORMAT {
depth => get_int8 (buf, i),
bits_per_pixel => get_int8 (buf, i+1),
scanline_pad => get_raw_format (buf, i+2)
};
fun get_visual_depth (buf, i, depth)
=
xt::VISUAL
{
visual_id => get_visual_id (buf, i),
depth,
bits_per_rgb => get_int8 (buf, i+5),
cmap_entries => get_int16 (buf, i+6),
red_mask => get_word (buf, i+8),
green_mask => get_word (buf, i+12),
blue_mask => get_word (buf, i+16),
ilk => case (w8v::get (buf, i+4))
#
0u0 => xt::STATIC_GRAY; 0u1 => xt::GRAY_SCALE;
0u2 => xt::STATIC_COLOR; 0u3 => xt::PSEUDO_COLOR;
0u4 => xt::TRUE_COLOR; 0u5 => xt::DIRECT_COLOR;
_ => xgripe::impossible "bad visual depth";
esac
};
fun get_visual_depth_list (buf, i, ndepths)
=
get_depths (ndepths, i, [])
where
fun get_depths (0, i, l)
=>
(list::reverse l, i);
get_depths (ndepths, i, l)
=>
{ depth = get_int8 (buf, i);
case (get_int16 (buf, i+2))
#
0 => get_depths (ndepths - 1, i+8, (xt::NO_VISUAL_FOR_THIS_DEPTH depth) ! l);
n_visuals => get_visuals (ndepths - 1, depth, n_visuals, i+8, l);
esac;
};
end
also
fun get_visuals (ndepths, _, 0, i, l)
=>
get_depths (ndepths, i, l);
get_visuals (ndepths, depth, k, i, l)
=>
get_visuals (ndepths, depth, k - 1, i+24, get_visual_depth (buf, i, depth) ! l);
end;
end;
fun get_screen (buf, i)
=
{ my (visuals, next)
=
get_visual_depth_list (buf, i+40, get_int8 (buf, i+39));
( { root_window => get_xid (buf, i),
default_colormap => get_xid (buf, i+4),
white_rgb8 => get_rgb8 (buf, i+8),
black_rgb8 => get_rgb8 (buf, i+12),
input_masks => get_event_mask (buf, i+16),
pixels_wide => get_int16 (buf, i+20),
pixels_high => get_int16 (buf, i+22),
millimeters_wide => get_int16 (buf, i+24),
millimeters_high => get_int16 (buf, i+26),
installed_colormaps => { min => get_int16 (buf, i+28), max => get_int16 (buf, i+30) },
root_visualid => get_visual_id (buf, i+32),
backing_store => get_bs (buf, i+36),
save_unders => get_bool (buf, i+37),
root_depth => get_int8 (buf, i+38),
visuals
},
next
);
};
fun get_pixmap_formats (buf, i, n)
=
{
trace {. "wire-to-value-pith.pkg: decode_connect_request_reply: get_pixmap_formats/TOP"; }; result =
get_list (get_pixmap_format, 8) (buf, i, n);
trace {. "wire-to-value-pith.pkg: decode_connect_request_reply: get_pixmap_formats/BOT"; }; result;
};
fun get_screens (buf, i, nscreens)
=
{
trace {. "wire-to-value-pith.pkg: decode_connect_request_reply: get_screens/TOP"; }; result =
get (nscreens, i, []);
trace {. "wire-to-value-pith.pkg: decode_connect_request_reply: get_screens/BOT"; }; result;
}
where
fun get (0, _, l)
=>
list::reverse l;
get (n, i, l)
=>
{ my (screen, next) = get_screen (buf, i);
get (n - 1, next, screen ! l);
};
end;
end;
herein
fun decode_connect_request_reply (prefix, msg)
=
{
trace {. "wire-to-value-pith.pkg: decode_connect_request_reply/TOP"; };
vendor_len = get_int16 (msg, 16);
trace {. "wire-to-value-pith.pkg: decode_connect_request_reply/AAA"; };
nscreens = get_int8 (msg, 20);
trace {. "wire-to-value-pith.pkg: decode_connect_request_reply/BBB"; };
nformats = get_int8 (msg, 21);
trace {. "wire-to-value-pith.pkg: decode_connect_request_reply/CCC"; };
format_offset = pad (32 + vendor_len);
trace {. "wire-to-value-pith.pkg: decode_connect_request_reply/DDD"; };
screen_offset = format_offset + 8*nformats;
trace {. "wire-to-value-pith.pkg: decode_connect_request_reply/EEE"; };
result =
{ protocol_version => { major => get_int16 (prefix, 2),
minor => get_int16 (prefix, 4)
},
release_number => get_int (msg, 0),
xid_base => get_word (msg, 4),
xid_mask => get_word (msg, 8),
motion_buf_size => get_int (msg, 12),
max_request_length => get_int16 (msg, 18),
image_byte_order => get_order (msg, 22),
bitmap_order => get_order (msg, 23),
bitmap_scanline_unit => get_raw_format (msg, 24),
bitmap_scanline_pad => get_raw_format (msg, 25),
min_keycode => get_key_code (msg, 26),
max_keycode => get_key_code (msg, 27),
vendor => get_string (msg, 32, vendor_len),
pixmap_formats => get_pixmap_formats (msg, format_offset, nformats),
screens => get_screens (msg, screen_offset, nscreens)
};
trace {. "wire-to-value-pith.pkg: decode_connect_request_reply/BOTTOM"; };
result;
};
end; # stipulate
# Decode event messages
stipulate
fun get_key_xevent buf
=
{ my (mks, mbs) = get_key_but_set (buf, 28);
{ keycode => get_key_code (buf, 1),
timestamp => get_xs_timestamp (buf, 4),
root_window_id => get_xid (buf, 8),
event_window_id => get_xid (buf, 12),
child_window_id => get_xid_option (buf, 16),
root_point => get_pt (buf, 20),
event_point => get_pt (buf, 24),
#
modifier_keys_state => mks,
mousebuttons_state => mbs,
same_screen => get_bool(buf, 30)
};
};
fun get_button_xevent buf
=
{ my (mks, mbs)
=
get_key_but_set (buf, 28);
{ mouse_button => xt::MOUSEBUTTON (get_int8 (buf, 1)),
timestamp => get_xs_timestamp (buf, 4),
root_window_id => get_xid (buf, 8),
event_window_id => get_xid (buf, 12),
child_window_id => get_xid_option (buf, 16),
root_point => get_pt (buf, 20),
event_point => get_pt (buf, 24),
#
modifier_keys_state => mks,
mousebuttons_state => mbs,
same_screen => get_bool (buf, 30)
};
};
fun decode_motion_notify buf
=
{ my (mks, mbs)
=
get_key_but_set (buf, 28);
xet::x::MOTION_NOTIFY
{
hint => get_bool (buf, 1),
timestamp => get_xs_timestamp (buf, 4),
root_window_id => get_xid (buf, 8),
event_window_id => get_xid (buf, 12),
child_window_id => get_xid_option (buf, 16),
root_point => get_pt (buf, 20),
event_point => get_pt (buf, 24),
modifier_keys_state => mks,
mousebuttons_state => mbs,
same_screen => get_bool (buf, 30)
};
};
fun get_enter_leave_xevent buf
=
{ my (mks, mbs)
=
get_key_but_set (buf, 28);
flags = get8 (buf, 31);
{ detail => get_focus_detail (buf, 1),
timestamp => get_xs_timestamp (buf, 4),
#
root_window_id => get_xid (buf, 8),
event_window_id => get_xid (buf, 12),
child_window_id => get_xid_option (buf, 16),
root_point => get_pt (buf, 20),
event_point => get_pt (buf, 24),
modifier_keys_state => mks,
mousebuttons_state => mbs,
mode => get_focus_mode (buf, 30),
focus => is_set (flags, 0u0),
same_screen => is_set (flags, 0u1)
};
};
fun get_focus_xevent buf
=
{ detail => get_focus_detail (buf, 1),
event_window_id => get_xid (buf, 4),
mode => get_focus_mode (buf, 8)
};
fun decode_keymap_notify buf
=
xet::x::KEYMAP_NOTIFY { }; # * NOTE: no seqn # # FIX *
fun decode_expose buf
=
xet::x::EXPOSE
{
exposed_window_id => get_xid (buf, 4),
boxes => [ get_box (buf, 8) ],
count => get_int16 (buf, 16)
};
fun decode_graphics_expose buf
=
xet::x::GRAPHICS_EXPOSE
{ drawable => get_xid (buf, 4),
box => get_box (buf, 8),
minor_opcode => get_word16 (buf, 16),
count => get_int16 (buf, 18),
major_opcode => get_word16 (buf, 20)
};
fun decode_no_expose buf
=
xet::x::NO_EXPOSE
{
drawable => get_xid (buf, 4),
minor_opcode => get_word16 (buf, 8),
major_opcode => get_word16 (buf, 10)
};
fun decode_visibility_notify buf
=
xet::x::VISIBILITY_NOTIFY
{
changed_window_id => get_xid (buf, 4),
state => case (w8v::get (buf, 8))
#
0u0 => xt::VISIBILITY_UNOBSCURED;
0u1 => xt::VISIBILITY_PARTIALLY_OBSCURED;
0u2 => xt::VISIBILITY_FULLY_OBSCURED;
_ => xgripe::impossible "bad VisibilityNotify";
esac
};
fun decode_create_notify buf
=
xet::x::CREATE_NOTIFY
{
parent_window_id => get_xid (buf, 4),
created_window_id => get_xid (buf, 8),
box => get_box (buf, 12),
border_wid => get_int16 (buf, 20),
override_redirect => get_bool (buf, 21)
};
fun decode_destroy_notify buf
=
xet::x::DESTROY_NOTIFY
{ event_window_id => get_xid (buf, 4),
destroyed_window_id => get_xid (buf, 8)
};
fun decode_unmap_notify buf
=
xet::x::UNMAP_NOTIFY
{
event_window_id => get_xid (buf, 4),
unmapped_window_id => get_xid (buf, 8),
from_config => get_bool (buf, 12)
};
fun decode_map_notify buf
=
xet::x::MAP_NOTIFY
{
event_window_id => get_xid (buf, 4),
mapped_window_id => get_xid (buf, 8),
#
override_redirect => get_bool (buf, 12)
};
fun decode_map_request buf
=
xet::x::MAP_REQUEST
{
parent_window_id => get_xid (buf, 4),
mapped_window_id => get_xid (buf, 8)
};
fun decode_reparent_notify buf
=
xet::x::REPARENT_NOTIFY
{
event_window_id => get_xid (buf, 4),
parent_window_id => get_xid (buf, 8),
rerooted_window_id => get_xid (buf, 12), # I suspect this should be "reparented_window_id"
#
upperleft_corner => get_pt (buf, 16),
override_redirect => get_bool (buf, 20)
};
fun decode_configure_notify buf
=
xet::x::CONFIGURE_NOTIFY
{
event_window_id => get_xid (buf, 4),
configured_window_id => get_xid (buf, 8),
sibling_window_id => get_xid_option (buf, 12),
#
box => get_box (buf, 16),
border_wid => get_int16 (buf, 20),
override_redirect => get_bool (buf, 22)
};
fun decode_configure_request buf
=
{ mask = get16 (buf, 26);
fun the_else get_fn (i, j)
=
is_set (mask, i) ?? THE (get_fn (buf, j))
:: NULL;
xet::x::CONFIGURE_REQUEST
{
stack_mode => if (not (is_set (mask, 0u6)))
NULL;
else
case (w8v::get (buf, 1))
#
0u0 => THE xt::ABOVE;
0u1 => THE xt::BELOW;
0u2 => THE xt::TOP_IF;
0u3 => THE xt::BOTTOM_IF;
0u4 => THE xt::OPPOSITE;
_ => xgripe::impossible "bad ConfigureRequest";
esac;
fi,
parent_window_id => get_xid (buf, 4),
configure_window_id => get_xid (buf, 8),
sibling_window_id => get_xid_option (buf, 12),
#
x => the_else get_signed16 (0u0, 16),
y => the_else get_signed16 (0u1, 18),
wide => the_else get_int16 (0u2, 20),
high => the_else get_int16 (0u3, 22),
border_wid => the_else get_int16 (0u4, 24)
};
};
fun decode_gravity_notify buf
=
xet::x::GRAVITY_NOTIFY
{
event_window_id => get_xid (buf, 4),
moved_window_id => get_xid (buf, 8),
#
upperleft_corner => get_pt (buf, 12)
};
fun decode_resize_request buf
=
xet::x::RESIZE_REQUEST
{
resize_window_id => get_xid (buf, 4),
req_size => get_size (buf, 8)
};
fun decode_circulate_notify buf
=
xet::x::CIRCULATE_NOTIFY
{
event_window_id => get_xid (buf, 4),
circulated_window_id => get_xid (buf, 8),
parent_window_id => get_xid (buf, 12),
#
place => get_stk_pos (buf, 16)
};
fun decode_circulate_request buf
=
xet::x::CIRCULATE_REQUEST
{
parent_window_id => get_xid (buf, 4),
circulate_window_id => get_xid (buf, 8),
place => get_stk_pos (buf, 12)
};
fun decode_property_notify buf
=
xet::x::PROPERTY_NOTIFY
{
changed_window_id => get_xid (buf, 4),
atom => get_xatom (buf, 8),
timestamp => get_xs_timestamp (buf, 12),
deleted => get_bool (buf, 16)
};
fun decode_selection_clear buf
=
xet::x::SELECTION_CLEAR
{
timestamp => get_xs_timestamp (buf, 4),
owning_window_id => get_xid (buf, 8),
selection => get_xatom (buf, 12)
};
fun decode_selection_request buf
=
xet::x::SELECTION_REQUEST
{
timestamp => get_xt_timestamp (buf, 4),
owning_window_id => get_xid (buf, 8),
requesting_window_id => get_xid (buf, 12),
selection => get_xatom (buf, 16),
target => get_xatom (buf, 20),
property => get_xatom_option (buf, 24)
};
fun decode_selection_notify buf
=
xet::x::SELECTION_NOTIFY
{
timestamp => get_xt_timestamp (buf, 4),
requesting_window_id => get_xid (buf, 8),
selection => get_xatom (buf, 12),
target => get_xatom (buf, 16),
property => get_xatom_option (buf, 20)
};
fun decode_colormap_notify buf
=
xet::x::COLORMAP_NOTIFY
{
window_id => get_xid (buf, 4),
cmap => get_xid_option (buf, 8),
new => get_bool (buf, 12),
installed => get_bool (buf, 13)
};
# ClientMessage is documented on pages 88 and 158 of:
#
# http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
fun decode_client_message buf
=
xet::x::CLIENT_MESSAGE
{
window_id => get_xid (buf, 4),
type => get_xatom (buf, 8),
#
value => xt::RAW_DATA
{
format => get_raw_format (buf, 1),
data => w8vextract (buf, 12, THE 20)
}
};
# MappingNotify is document on page 88 (see also 68, 69, 72, 158) of:
#
# http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
fun decode_mapping_notify buf
=
case (w8v::get (buf, 4))
#
0u0 => xet::x::MODIFIER_MAPPING_NOTIFY;
0u1 => xet::x::KEYBOARD_MAPPING_NOTIFY
{
first_keycode => get_key_code (buf, 5),
count => get_int8 (buf, 6)
};
0u2 => xet::x::POINTER_MAPPING_NOTIFY;
_ => xgripe::impossible "bad MappingNotify";
esac;
herein
# Page numbers below are for http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
# Page 1 comments that
#
# "Every event contains an 8-bit type code.
# The most-significant bit in this code
# is set if the event was generated by a
# SendEvent request."
#
# The "type code" must be byte 0, 'code' below.
#
# Individual X event layouts are documented
# starting on page 150.
fun decode_xpacket (code: one_byte_unt::Unt, buf)
=
{
n = w8::bitwise_and (code, 0ux7f);
xevent = case n
#
0u2 => xet::x::KEY_PRESS (get_key_xevent buf);
0u3 => xet::x::KEY_RELEASE (get_key_xevent buf);
0u4 => xet::x::BUTTON_PRESS (get_button_xevent buf);
0u5 => xet::x::BUTTON_RELEASE (get_button_xevent buf);
0u6 => decode_motion_notify buf;
0u7 => xet::x::ENTER_NOTIFY (get_enter_leave_xevent buf);
0u8 => xet::x::LEAVE_NOTIFY (get_enter_leave_xevent buf);
0u9 => xet::x::FOCUS_IN (get_focus_xevent buf);
0u10 => xet::x::FOCUS_OUT (get_focus_xevent buf);
0u11 => decode_keymap_notify buf;
0u12 => decode_expose buf;
0u13 => decode_graphics_expose buf;
0u14 => decode_no_expose buf;
0u15 => decode_visibility_notify buf;
0u16 => decode_create_notify buf;
0u17 => decode_destroy_notify buf;
0u18 => decode_unmap_notify buf;
0u19 => decode_map_notify buf;
0u20 => decode_map_request buf;
0u21 => decode_reparent_notify buf;
0u22 => decode_configure_notify buf;
0u23 => decode_configure_request buf;
0u24 => decode_gravity_notify buf;
0u25 => decode_resize_request buf;
0u26 => decode_circulate_notify buf;
0u27 => decode_circulate_request buf;
0u28 => decode_property_notify buf;
0u29 => decode_selection_clear buf;
0u30 => decode_selection_request buf;
0u31 => decode_selection_notify buf;
0u32 => decode_colormap_notify buf;
0u33 => decode_client_message buf;
0u34 => decode_mapping_notify buf;
_ => xgripe::impossible "bad event code";
esac;
( code == n, # FALSE means that this event was faked via SendEvent request.
xevent
);
};
# We export the decode functions
# for reporting graphics exposures
#
decode_graphics_expose = decode_graphics_expose;
decode_no_expose = decode_no_expose;
end; # stipulate
# Decode error messages:
#
stipulate
fun get_error (kind, buf)
=
xe::XERROR
{
kind,
minor_op => get_word16 (buf, 8),
major_op => w8v::get (buf, 10)
};
herein
fun decode_error buf
=
case (w8v::get (buf, 1))
#
0u1 => get_error (xe::BAD_REQUEST, buf);
0u2 => get_error (xe::BAD_VALUE (get_string (buf, 4, 4)), buf);
0u3 => get_error (xe::BAD_WINDOW (get_xid (buf, 4)), buf);
0u4 => get_error (xe::BAD_PIXMAP (get_xid (buf, 4)), buf);
0u5 => get_error (xe::BAD_ATOM (get_xid (buf, 4)), buf);
0u6 => get_error (xe::BAD_CURSOR (get_xid (buf, 4)), buf);
0u7 => get_error (xe::BAD_FONT (get_xid (buf, 4)), buf);
0u8 => get_error (xe::BAD_MATCH, buf);
0u9 => get_error (xe::BAD_DRAWABLE (get_xid (buf, 4)), buf);
0u10 => get_error (xe::BAD_ACCESS, buf);
0u11 => get_error (xe::BAD_ALLOC, buf);
0u12 => get_error (xe::BAD_COLOR (get_xid (buf, 4)), buf);
0u13 => get_error (xe::BAD_GC (get_xid (buf, 4)), buf);
0u14 => get_error (xe::BAD_IDCHOICE (get_xid (buf, 4)), buf);
0u15 => get_error (xe::BAD_NAME, buf);
0u16 => get_error (xe::BAD_LENGTH, buf);
0u17 => get_error (xe::BAD_IMPLEMENTATION, buf);
#
_ => xgripe::impossible "bad error number";
esac;
end;
# Decode reply messages.
#
fun decode_get_window_attributes_reply msg
=
{
backing_store => get_bs (msg, 1),
visual => get_visual_id (msg, 8),
input_only => case (get16 (msg, 12))
#
0u1 => FALSE;
0u2 => TRUE;
_ => xgripe::impossible "bad GetWindowAttributes reply";
esac,
bit_gravity => get_bit_gravity (msg, 14),
window_gravity => get_window_gravity (msg, 15),
backing_planes => xt::PLANEMASK (get_word (msg, 16)),
backing_pixel => get_rgb8 (msg, 20),
save_under => get_bool (msg, 24),
map_is_installed => get_bool (msg, 25),
map_state => case (w8v::get (msg, 26))
#
0u0 => xt::WINDOW_IS_UNMAPPED;
0u1 => xt::WINDOW_IS_UNVIEWABLE;
0u2 => xt::WINDOW_IS_VIEWABLE;
_ => xgripe::impossible "bad GetWindowAttributes reply";
esac,
override_redirect => get_bool (msg, 27),
colormap => get_xid_option (msg, 28),
all_event_mask => get_event_mask (msg, 32),
event_mask => get_event_mask (msg, 36),
do_not_propagate => get_event_mask (msg, 40)
};
fun decode_alloc_color_cells_reply msg
=
{ err => xgripe::impossible "unimplemented" # ** FIX ** XXX BUGGO FIXME
};
fun decode_alloc_color_planes_reply msg
=
{ err => xgripe::impossible "unimplemented" # ** FIX ** XXX BUGGO FIXME
};
fun decode_alloc_color_reply msg
=
{ visual_rgb => get_rgb (msg, 8),
pixel => get_rgb8 (msg, 16)
};
fun decode_alloc_named_color_reply msg
=
{ pixel => get_rgb8 (msg, 8),
exact_rgb => get_rgb (msg, 12),
visual_rgb => get_rgb (msg, 18)
};
fun decode_get_atom_name_reply msg
=
get_string (msg, 32, get_int16 (msg, 8));
fun decode_get_font_path_reply msg
=
get_string_list (msg, 32, get_int16 (msg, 8));
fun decode_get_geometry_reply msg
=
{ depth => get_int8 (msg, 1),
root => get_xid (msg, 8),
geometry => get_wgeom (msg, 12)
};
fun decode_get_image_reply msg
=
{ depth => get_int8 (msg, 1),
visualid => get_visual_id_option (msg, 8),
data => w8vextract (msg, 32, THE (4*get_int (msg, 4)))
};
fun decode_get_input_focus_reply msg
=
{ revert_to => case (w8v::get (msg, 1))
#
0u0 => xt::REVERT_TO_NONE;
0u1 => xt::REVERT_TO_POINTER_ROOT;
_ => xt::REVERT_TO_PARENT;
esac,
focus => case (get_word (msg, 8))
#
0u0 => xt::INPUT_FOCUS_NONE;
0u1 => xt::INPUT_FOCUS_POINTER_ROOT;
w => xt::INPUT_FOCUS_WINDOW (xt::xid_from_unt w);
esac
};
fun decode_get_keyboard_control_reply msg
=
{
glob_auto_repeat => get_bool (msg, 1),
led_mask => get32 (msg, 8),
key_click_pct => get_int8 (msg, 12),
bell_pct => get_int8 (msg, 13),
bell_pitch => get_int16 (msg, 14),
bell_duration => get_int16 (msg, 16),
auto_repeats => w8vextract (msg, 20, THE 32)
};
fun decode_get_keyboard_mapping_reply msg
=
{
syms_per_code = get_int8 (msg, 1);
n_key_codes = get_int (msg, 4) / syms_per_code;
# Get the keysyms bound to a given keycode;
# Discard trailing NoSymbols,
# but include intermediate ones.
#
fun clean_tl (xt::NO_SYMBOL ! r) => clean_tl r;
clean_tl l => reverse l;
end;
fun get_syms (i, 0, l) => clean_tl l;
#
get_syms (i, j, l) => case (get_int (msg, i))
#
0 => get_syms (i+4, j - 1, xt::NO_SYMBOL ! l);
k => get_syms (i+4, j - 1, (xt::KEYSYM k) ! l);
esac;
end;
get_list
( \\ (_, i) = get_syms (i, syms_per_code, []),
syms_per_code * 4
)
(msg, 32, n_key_codes);
};
fun decode_get_modifier_mapping_reply msg
=
{ shift_keycodes => get_syms 0,
lock_keycodes => get_syms 1,
cntl_keycodes => get_syms 2,
mod1_keycodes => get_syms 3,
mod2_keycodes => get_syms 4,
mod3_keycodes => get_syms 5,
mod4_keycodes => get_syms 6,
mod5_keycodes => get_syms 7
}
where
codes_per_mod = get_int8 (msg, 1);
#
fun get_syms k
=
get (32 + codes_per_mod*k, codes_per_mod)
where
fun get (i, 0) => [];
#
get (i, j) => case (get_int8 (msg, i))
#
0 => get (i+1, j - 1); # 0 == unused
k => (xt::KEYCODE k) ! get (i+1, j - 1);
esac;
end;
end;
end;
stipulate
#
get_events = get_list
( \\ (buf, i) = { timestamp => get_xt_timestamp (buf, i ),
coord => get_pt (buf, i+4)
},
8
);
herein
#
fun decode_get_motion_events_reply msg
=
get_events (msg, 32, get_int16 (msg, 8));
end;
fun decode_get_pointer_control_reply msg
=
{ acceleration_numerator => get16 (msg, 8),
acceleration_denominator => get16 (msg, 10),
threshold => get16 (msg, 12)
};
fun decode_get_pointer_mapping_reply msg
=
{ err => xgripe::impossible "unimplemented" # XXX SUCKO FIXME
};
fun decode_get_property_reply msg
=
case (get_word (msg, 8))
#
0u0 => NULL;
t => { nitems = get_int (msg, 16);
#
my (fmt, nbytes)
=
case (w8v::get (msg, 1))
#
0u8 => (xt::RAW08, nitems);
0u16 => (xt::RAW16, 2*nitems);
0u32 => (xt::RAW32, 4*nitems);
#
_ => xgripe::impossible "bad GetProperty reply";
esac;
THE { type => xt::XATOM t,
bytes_after => get_int (msg, 12),
value => xt::RAW_DATA { format => fmt,
data => w8vextract (msg, 32, THE nbytes)
}
};
};
esac;
fun decode_get_screen_saver_reply msg
=
{ timeout => get16 (msg, 8),
interval => get16 (msg, 10),
prefer_blanking => get_bool (msg, 12),
allow_exposures => get_bool (msg, 13)
};
fun decode_get_selection_owner_reply msg
=
get_xid_option (msg, 8);
stipulate
#
fun decode_grab_reply msg
=
case (w8v::get (msg, 1))
#
0u0 => xt::GRAB_SUCCESS;
0u1 => xt::ALREADY_GRABBED;
0u2 => xt::GRAB_INVALID_TIME;
0u3 => xt::GRAB_NOT_VIEWABLE;
_ => xt::GRAB_FROZEN;
esac;
herein
decode_grab_keyboard_reply = decode_grab_reply;
decode_grab_pointer_reply = decode_grab_reply;
end;
fun decode_intern_atom_reply msg
=
get_xatom (msg, 8);
fun decode_list_extensions_reply msg
=
get_string_list (msg, 32, get_int8 (msg, 1));
fun decode_list_fonts_reply msg
=
get_string_list (msg, 32, get_int16 (msg, 8));
stipulate
#
fun get_host_list (buf, n)
=
get (32, n, [])
where
fun get (_, 0, l)
=>
l;
get (i, n, l)
=>
{ addr_len = get_int16 (buf, i+2);
address = get_string (buf, i+4, addr_len);
host = case (w8v::get (buf, i))
#
0u0 => xt::INTERNET_HOST address;
0u1 => xt::DECNET_HOST address;
0u2 => xt::CHAOS_HOST address;
_ => raise exception (xgripe::xerror "unknown host family");
esac;
get (i+(pad addr_len)+4, n - 1, host ! l);
};
end;
end;
herein
fun decode_list_hosts_reply msg
=
{ enabled => get_bool (msg, 1),
hosts => get_host_list (msg, get_int16 (msg, 8))
};
end; # stipulate
fun decode_list_installed_colormaps_reply msg
=
get_xid_list (msg, 32, get_int16 (msg, 8));
fun decode_list_properties_reply msg
=
get_xatom_list (msg, 32, get_int16 (msg, 8));
fun decode_lookup_color_reply msg
=
{ exact_rgb => get_rgb (msg, 8),
visual_rgb => get_rgb (msg, 14)
};
fun decode_query_best_size_reply msg
=
{ wide => get_int16 (msg, 8),
high => get_int16 (msg, 10)
};
stipulate
#
get_rgblist = get_list (get_rgb, 8);
herein
#
fun decode_query_colors_reply msg
=
get_rgblist (msg, 32, get_int16 (msg, 8));
end;
fun decode_query_extension_reply msg
=
{ err => xgripe::impossible "unimplemented" # XXX BUGGO FIXME
};
stipulate
#
get_props = get_list
( \\ (buf, i) = xt::FONT_PROP { name => get_xatom (buf, i ),
value => get32 (buf, i+4)
},
8
);
fun get_char_info (buf, i)
=
xt::CHAR_INFO
{
left_bearing => get_signed16 (buf, i),
right_bearing => get_signed16 (buf, i+2),
char_width => get_signed16 (buf, i+4),
ascent => get_signed16 (buf, i+6),
descent => get_signed16 (buf, i+8),
attributes => get_word16 (buf, i+10)
};
get_char_info_list
=
get_list (get_char_info, 12);
fun get_info buf # For background here see p38 and p131 in http://mythryl.org/pub/exene/X-protocol-R7.pdf
= #
{ n_props = get_int16 (buf, 46);
#
{ min_bounds => get_char_info (buf, 8),
max_bounds => get_char_info (buf, 24),
min_char => get_int16 (buf, 40), # "min-char-or-byte2" in protocol doc.
max_char => get_int16 (buf, 42), # "max-char-or-byte2" in protocol doc.
default_char => get_int16 (buf, 44),
draw_dir => get_font_dir (buf, 48),
min_byte1 => get_int8 (buf, 49),
max_byte1 => get_int8 (buf, 50),
all_chars_exist => get_bool (buf, 51),
font_ascent => get_int16 (buf, 52),
font_descent => get_int16 (buf, 54),
n_props,
properties => get_props (buf, 60, n_props)
};
};
herein
/****** THIS GENERATES MULTIPLE REPLIES ****
# this gets a list of font name/info replies
fun decodeListFontsWithInfoReply msg = let
fun getList l = let
my (msg, extra) = getReply (connection, sizeOfListFontsWithInfoReply)
name_len = get8 (msg, 1)
in
if (name_len == 0)
then # this is the last in a series of replies
(reverse l)
else let
info = getInfo (msg, extra)
reply = {
min_bounds = info.min_bounds,
max_bounds = info.max_bounds,
min_char = info.min_char,
max_char = info.max_char,
default_char = info.default_char,
draw_dir = info.draw_dir,
min_byte1 = info.min_byte1,
max_byte1 = info.max_byte1,
all_chars_exist = info.all_chars_exist,
font_ascent = info.font_ascent,
font_descent = info.font_descent,
replies_hint = get32 (msg, 56),
properties = info.properties,
name = get_string (extra, 8*info.n_props, name_len)
}
in
getList (reply ! l)
end
end # getList
in
getList []
end # getListFontsWithInfoReply
*********/
fun decode_query_font_reply msg
=
{ info = get_info msg;
#
{ min_bounds => info.min_bounds,
max_bounds => info.max_bounds,
min_char => info.min_char,
max_char => info.max_char,
default_char => info.default_char,
draw_dir => info.draw_dir,
min_byte1 => info.min_byte1,
max_byte1 => info.max_byte1,
all_chars_exist => info.all_chars_exist,
font_ascent => info.font_ascent,
font_descent => info.font_descent,
properties => info.properties,
char_infos => get_char_info_list (msg, 60+8*info.n_props, get_int (msg, 56))
};
};
end; # stipulate
fun decode_query_keymap_reply msg
=
{ err => xgripe::impossible "unimplemented" # ** FIX **
};
fun decode_query_pointer_reply msg
=
{ (get_key_but_set (msg, 24))
->
(mks, mbs);
{ same_screen => get_bool (msg, 1),
root => get_xid (msg, 8),
child => get_xid_option (msg, 12),
root_point => get_pt (msg, 16),
window_point => get_pt (msg, 20),
modifier_keys_state => mks,
mousebuttons_state => mbs
};
};
fun decode_query_text_extents_reply msg
=
{ draw_direction => get_font_dir (msg, 1),
font_ascent => get16 (msg, 8),
font_descent => get16 (msg, 10),
overall_ascent => get16 (msg, 12),
overall_descent => get16 (msg, 14),
overall_width => get16 (msg, 16),
overall_left => get16 (msg, 18),
overall_right => get16 (msg, 20)
};
fun decode_query_tree_reply msg
=
{ root => get_xid (msg, 8),
parent => get_xid_option (msg, 12),
children => get_xid_list (msg, 32, get_int16 (msg, 16))
};
stipulate
#
fun get_set_mapping_reply msg
=
case (get8 (msg, 1))
#
0u0 => xt::MAPPING_SUCCESS;
0u1 => xt::MAPPING_BUSY;
_ => xt::MAPPING_FAILED;
esac;
herein
decode_set_modifier_mapping_reply = get_set_mapping_reply;
decode_set_pointer_mapping_reply = get_set_mapping_reply;
end;
fun decode_translate_coordinates_reply msg
=
{ child => get_xid_option (msg, 8),
to_point => get_pt (msg, 12)
};
end; # stipulate
}; # package wire_to_value
end;