## xsession.pkg
#
# This package has the highest-level responsibility for
# managing all the state and operations relating to
# communication with a given X server.
#
#
# Architecture
# ------------
#
# Nomenclature: An 'imp' is a server thread.
# (Like a daemon, but smaller!)
#
# An xsession is built of seven imps.
#
# Adapting from the page 8 diagram in
# http:://mythryl.org/pub/exene/1991-ml-workshop.pdf
# our dataflow network for xsession looks like:
#
# ----------------------
# | X server process |
# ----------------------
# ^ |
# | v
# -------<network socket>------------- network and process boundary.
# ^ |
# | v --- --- ---
# ---------- ---------- . . .
# | outbuf | | inbuf | . . .
# | imp | | imp | . . .
# ---------- ---------- . . .
# ^ | . . .
# | v . . .
# --------------------------- ----------------- . . .
# | sequencer imp |--> | error handler | ... xsocket . .
# --------------------------- ----------------- . imps . .
# ^ ^ ^ | xevents . . .
# | | | v . ... xsession .
# | | | ---------- . . imps .
# | | | | xbuf | . . .
# | | | | imp | . . .
# | | | ---------- --- . .
# | | | | xevents . .
# v | | v . .
# ---------- | | --------------- ---------- . .
# | font | | | | xbuf to | | keymap | . .
# | imp | | | | widgettree |--> | imp | . .
# ---------- | | | root xevent |--> | | . .... xclient
# ^ | | | router imp | | | . . imps
# | | | --------------- ---------- . .
# | | | | xevents ^ --- .
# | ---------- | | | .
# | |pen imp | | | | .
# | ---------- | | | .
# | ^ | | | .
# | | | | | .
# | v | | | .
# | ---------- | | .
# | |draw imp| | | .
# | ---------- | | .
# | ^ | | .
# | | | xevents | ---
# v | v v
# (..........to/from widget threads............)
# |
# | xevents
# v
# ---------------
# | widgettree |
# | root xevent |
# | router imp |
# ---------------
# / \
# / widget \
# / tree \
# / \
# / ... \
#
# Dramatis Personae:
#
# o The sequencer imp matches replies to requests.
# All traffic to/from the X server goes through it.
# Implemented in: src/lib/x-kit/xclient/pkg/wire/xsocket.pkg#
# o The outbuf imp optimizes network usage by
# combining multiple requests per network packet.
# Implemented in: src/lib/x-kit/xclient/pkg/wire/xsocket.pkg#
# o The inbuf imp breaks the incoming bytestream
# into individual replies and forwards them individually
# to the sequencer thread.
# Implemented in: src/lib/x-kit/xclient/pkg/wire/xsocket.pkg#
# o The xbuf imp combines multiple related expose events
# into a single logical message for ease of downstream
# processing.
# Implemented in: src/lib/x-kit/xclient/pkg/wire/xsocket.pkg#
# o The xsocket_to_topwindow_router imp receives all X events
# (e.g. keystrokes and mouseclicks) and feeds each one to the
# appropriate toplevel window, or more precisely to the
# topwindow_to_widget_router at the root of the widgettree for
# that window, there to trickle down the widgettree to its ultimate
# target widget.
#
# To do this, the xsocket_to_topwindow_router imp
# tracks all X windows created by the application,
# keyed by their X IDs. (Toplevel X windows are
# registered at creation by the window.pkg functions;
# subwindows are registered when their X notify event
# comes through.)
#
# Implemented in: src/lib/x-kit/xclient/pkg/window/xsocket-to-topwindow-router.pkg# See also: src/lib/x-kit/xclient/pkg/window/topwindow-to-widget-router.pkg#
# o The font imp ...
# Implemented in: src/lib/x-kit/xclient/pkg/window/font-imp.pkg#
# o The keymap imp ...
# Implemented in: src/lib/x-kit/xclient/pkg/window/keymap-imp.pkg#
#
# o The draw_imp buffers draw commands and combines
# them into subsequences which can share a single
# X server graphics context, in order to minimize
# the number of graphics context switches required.
# It works closely with the pen-to-gcontext-imp.
# Implemented in: src/lib/x-kit/xclient/pkg/window/draw-imp.pkg#
# o The pen_to_gcontext_imp maps between the immutable "pens"
# we provide to the application programmer and the mutable
# graphics contexts actually supported by the X server. Given
# a pen, it returns a matching graphics context, using an
# existing one unchanged if possible, else modifying an
# existing one appropropriately.
# Implemented in: src/lib/x-kit/xclient/pkg/window/pen-to-gcontext-imp.pkg#
#
# All mouse and keyboard events flow down through the
# inbuf, sequencer, xbuf and xbuf-to-widgettree imps
# and thence down through the widget hierarchy
# associated with a the relevant topwindow.
#
# Client xserver requests and responses are sent
# directly to the sequencer imp, with the exception
# of font requests and responses, whic run through
# the font imp.
#
# Keysym translations are handled by the keymap imp.
# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib### "I have always wished that my computer
### would be as easy to use as my telephone.
### My wish has come true ... I no longer
### know how to use my telephone."
###
### -- Bjarne Stroustrup
stipulate
include threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package s2t = xsocket_to_topwindow_router; # xsocket_to_topwindow_router is from src/lib/x-kit/xclient/pkg/window/xsocket-to-topwindow-router.pkg #
package xg = xgeometry; # xgeometry is from src/lib/std/2d/xgeometry.pkg package xok = xsocket; # xsocket is from src/lib/x-kit/xclient/pkg/wire/xsocket.pkg package dy = display; # display is from src/lib/x-kit/xclient/pkg/wire/display.pkg package ai = atom_imp; # atom_imp is from src/lib/x-kit/xclient/pkg/iccc/atom-imp.pkg package cs = color_spec; # color_spec is from src/lib/x-kit/xclient/pkg/window/color-spec.pkg package di = draw_imp; # draw_imp is from src/lib/x-kit/xclient/pkg/window/draw-imp.pkg package fti = font_imp; # "fi" is taken! :-) # font_imp is from src/lib/x-kit/xclient/pkg/window/font-imp.pkg package p2g = pen_to_gcontext_imp; # pen_to_gcontext_imp is from src/lib/x-kit/xclient/pkg/window/pen-to-gcontext-imp.pkg package kab = keys_and_buttons; # keys_and_buttons is from src/lib/x-kit/xclient/pkg/wire/keys-and-buttons.pkg package ki = keymap_imp; # keymap_imp is from src/lib/x-kit/xclient/pkg/window/keymap-imp.pkg package si = selection_imp; # selection_imp is from src/lib/x-kit/xclient/pkg/window/selection-imp.pkg package v2w = value_to_wire; # value_to_wire is from src/lib/x-kit/xclient/pkg/wire/value-to-wire.pkg package s2w = sendevent_to_wire; # sendevent_to_wire is from src/lib/x-kit/xclient/pkg/wire/sendevent-to-wire.pkg package w2v = wire_to_value; # wire_to_value is from src/lib/x-kit/xclient/pkg/wire/wire-to-value.pkg package wpi = window_property_imp; # window_property_imp is from src/lib/x-kit/xclient/pkg/window/window-property-imp.pkg package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/pkg/wire/xtypes.pkg package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/pkg/stuff/xlogger.pkg #
trace = xtr::log_if xtr::io_logging; # Conditionally write strings to tracing.log or whatever.
herein
package xsession
: Xsession # Xsession is from src/lib/x-kit/xclient/pkg/window/xsession.api {
Xsession
=
XSESSION {
xdisplay: dy::Xdisplay, #
screens: List( Screen_Info ),
default_screen_info: Screen_Info,
xsocket_to_topwindow_router: s2t::Xsocket_To_Topwindow_Router, # Feeds X events to appropriate toplevel window.
font_imp: fti::Font_Imp,
atom_imp: ai::Atom_Imp,
window_property_imp: wpi::Window_Property_Imp,
selection_imp: si::Selection_Imp,
keymap_imp: ki::Keymap_Imp
}
also
Screen_Info
=
SCREEN_INFO
{
xscreen: dy::Xscreen, # Xscreen def in src/lib/x-kit/xclient/pkg/wire/display.pkg per_depth_pen_and_draw_imps: List( Screen_Pen_And_Draw_Imps ), # The pen-to-gcontext and draw imps for the supported depths on this screen.
rootwindow_pen_and_draw_imps: Screen_Pen_And_Draw_Imps # The pen-to-gcontext and draw imps for the root window on this screen.
}
also
Screen_Pen_And_Draw_Imps
=
# For each combination of visual and depth
# we allocate a pair of imps, one to draw,
# one to manage graphics contexts. This
# is forced because X requires that each
# gc and pixmap be associated with a
# particular screen, visual and depth:
#
SCREEN_PEN_AND_DRAW_IMPS { # The pen-to-gcontext imp and draw_imp
# # for a given depth, visual and screen.
depth: Int,
pen_imp: p2g::Pen_To_Gcontext_Imp, # The pen-to-gcontext imp for this depth on this screen.
to_screen_drawimp: di::d::Draw_Op -> Void # The rootwindow draw-imp for this depth on this screen.
}
also
Screen # A screen handle for users.
=
SCREEN {
xsession: Xsession,
screen_info: Screen_Info
};
# An on-screen pixmap:
#
Window
=
WINDOW
{
window_id: xt::Window_Id,
#
screen: Screen,
screen_pen_and_draw_imps: Screen_Pen_And_Draw_Imps,
#
to_topwindow_drawimp: di::d::Draw_Op -> Void
};
# Identity tests:
#
fun same_xsession
( XSESSION { xdisplay=>dy::XDISPLAY { xsocket => x1, ... }, ... },
XSESSION { xdisplay=>dy::XDISPLAY { xsocket => x2, ... }, ... }
)
=
xok::same_xsocket (x1, x2);
fun same_screen ( SCREEN { xsession=>xsession1, screen_info=>SCREEN_INFO { xscreen => dy::XSCREEN { id=>id1, ... }, ... }},
SCREEN { xsession=>xsession2, screen_info=>SCREEN_INFO { xscreen => dy::XSCREEN { id=>id2, ... }, ... }}
)
=
(id1 == id2)
and
same_xsession (xsession1, xsession2);
fun same_window ( WINDOW { window_id=>id1, screen=>s1, ... },
WINDOW { window_id=>id2, screen=>s2, ... } )
=
(id1 == id2) and same_screen (s1, s2);
# See overview comments in
#
# src/lib/x-kit/xclient/pkg/window/xsession.api #
fun open_xsession
( display_name: String,
xauthentication: Null_Or( xt::Xauthentication ) # Xauthentication info comes ultimately from ~/.Xauthority
)
=
{ # We turn this off in close_xession, so for symmetry's
# sake we turn it on here in open_xsession:
# # tracing is from src/lib/src/lib/thread-kit/src/lib/logger.pkg logger::disable thread_deathwatch::logging; # thread_deathwatch is from src/lib/src/lib/thread-kit/src/lib/thread-deathwatch.pkg my (xdisplay as dy::XDISPLAY { default_screen, screens, xsocket, next_xid, ... } )
=
dy::open_xdisplay { display_name, xauthentication };
keymap_imp = ki::make_keymap_imp xdisplay;
atom_imp = ai::make_atom_imp xdisplay;
(wpi::make_window_property_imp (xdisplay, atom_imp))
->
(to_window_property_imp_slot, window_property_imp);
(si::make_selection_imp xdisplay)
->
(to_selection_imp_slot, selection_imp);
xsocket_to_topwindow_router
=
s2t::make_xsocket_to_topwindow_router
{ xdisplay,
keymap_imp,
#
to_window_property_imp_slot,
to_selection_imp_slot
};
fun make_screen_info (xscreen as dy::XSCREEN { root_window_id, root_visual, visuals, ... } )
=
{ fun make_screen_pen_and_draw_imps (depth, pen_imp)
=
{ drawimp_mappedstate_slot = make_mailslot ();
make_thread "send FIRST_EXPOSE" .{ give (drawimp_mappedstate_slot, di::s::FIRST_EXPOSE); };
trace .{ "XYZZY xsession: open_xsession: make_screen_info: make_screen_pen_and_draw_imps: Making SCREEN_PEN_AND_DRAW_IMPS record"; };
SCREEN_PEN_AND_DRAW_IMPS {
depth,
pen_imp,
to_screen_drawimp
=>
di::make_draw_imp
( take' drawimp_mappedstate_slot,
pen_imp,
xsocket_to_topwindow_router,
xsocket
)
};
};
fun make_pen_imps ([], l)
=>
l;
make_pen_imps (vd ! r, l)
=>
{
visual_depth = dy::depth_of_visual vd;
trace .{ sprintf "XYZZY xsession: open_xsession: make_pen_imps: visual_depth d=%d Making root_imps" visual_depth; };
fun make_imps ()
=
{ pixmap_id = next_xid ();
# Make a pixmap to serve as the
# witness drawable for the GC server:
#
xok::send_xrequest xsocket
( value_to_wire::encode_create_pixmap
{ pixmap_id,
drawable_id => root_window_id,
size => xg::SIZE { wide=>1, high=>1 },
depth => visual_depth
}
);
make_screen_pen_and_draw_imps
(visual_depth, p2g::make_pen_to_gcontext_imp (xdisplay, pixmap_id));
};
fun get []
=>
make_imps() ! l;
get (SCREEN_PEN_AND_DRAW_IMPS { depth, ... } ! rest)
=>
depth == visual_depth
?? l
:: get rest;
end;
make_pen_imps (r, get l);
};
end;
trace .{ "XYZZY xsession: open_xsession: Making root_imps"; };
rootwindow_pen_and_draw_imps
=
make_screen_pen_and_draw_imps
(
dy::depth_of_visual root_visual,
p2g::make_pen_to_gcontext_imp (xdisplay, root_window_id)
);
trace .{ "XYZZY xsession: open_xsession: Making per-visual imps"; };
per_depth_pen_and_draw_imps
=
make_pen_imps (visuals, [ rootwindow_pen_and_draw_imps ]);
trace .{ "XYZZY xsession: open_xsession: Making NO_VISUAL_FOR_THIS_DEPTH 1 imp-pair"; };
per_depth_pen_and_draw_imps
=
make_pen_imps ( [ xt::NO_VISUAL_FOR_THIS_DEPTH 1 ],
per_depth_pen_and_draw_imps
);
trace .{ "XYZZY xsession: open_xsession: building and returning SCREEN_INFO record"; };
SCREEN_INFO
{
xscreen,
per_depth_pen_and_draw_imps,
rootwindow_pen_and_draw_imps
};
};
screens = map make_screen_info screens;
XSESSION
{
xdisplay,
default_screen_info => list::nth (screens, default_screen),
screens,
xsocket_to_topwindow_router,
atom_imp,
font_imp => fti::make_font_imp xdisplay,
window_property_imp,
selection_imp,
keymap_imp
};
}; # fun open_xsession
# X-server I/O.
#
stipulate
fun apply_to_xsocket f (XSESSION { xdisplay=>dy::XDISPLAY { xsocket, ... }, ... } )
=
f xsocket;
herein
send_xrequest = apply_to_xsocket xok::send_xrequest;
send_xrequest_and_verify_success = apply_to_xsocket xok::send_xrequest_and_verify_success;
send_xrequest_and_read_reply = apply_to_xsocket xok::send_xrequest_and_read_reply;
sent_xrequest_and_read_replies = apply_to_xsocket xok::sent_xrequest_and_read_replies;
flush_out = apply_to_xsocket xok::flush;
query_best_size = apply_to_xsocket xok::query_best_size;
query_colors = apply_to_xsocket xok::query_colors;
query_font = apply_to_xsocket xok::query_font;
query_pointer = apply_to_xsocket xok::query_pointer;
query_text_extents = apply_to_xsocket xok::query_text_extents;
query_tree = apply_to_xsocket xok::query_tree;
end;
# Get location of mouse pointer
# plus related information:
#
fun get_mouse_location
(XSESSION
{ xdisplay => dy::XDISPLAY { xsocket, ... },
default_screen_info => SCREEN_INFO { xscreen => dy::XSCREEN { root_window_id, ... }, ... },
...
}
)
=
{ # The X server query_pointer call takes a window_id
# argument. This seems overcomplex for the typical
# Mythryl caller, so here we just default it to the
# the default-screen root-window:
#
(xok::query_pointer xsocket { window_id => root_window_id })
->
{ root_point, ... };
# The X server query_pointer call returns
# a load of stuff. For now at least, a
# return value of simply the mouse location
# seems more convenient for the Mythryl app hacker:
#
root_point;
};
fun set_mouse_location
(
XSESSION
{ xdisplay => dy::XDISPLAY { xsocket, ... },
default_screen_info => SCREEN_INFO { xscreen => dy::XSCREEN { root_window_id, ... }, ... },
...
}
)
to_point
=
{ # This is an ignored dummy value:
#
from_box = xg::BOX { col => 0, row => 0, wide => 0, high => 0 };
command
=
v2w::encode_warp_pointer
{
to_point, # Move mouse pointer to this coordinate.
to => THE root_window_id, # Position mouse relative to root window.
# # (That is, in absolute screen coordinates.)
from => NULL,
from_box # Ignored because 'from' is NULL.
};
xok::send_xrequest xsocket command;
};
# Map a point in the window's coordinate
# system to the screen's coordinate system:
#
fun window_point_to_screen_point (WINDOW { window_id, screen, ... } ) pt
=
{ screen -> SCREEN { xsession, screen_info => SCREEN_INFO { xscreen => dy::XSCREEN { root_window_id, ... }, ... }, ... };
my { to_point, ... }
=
w2v::decode_translate_coordinates_reply
(
do_mailop
(send_xrequest_and_read_reply
xsession
(v2w::encode_translate_coordinates { from_window=>window_id, to_window=>root_window_id, from_point=>pt } )
)
);
to_point;
};
# Fake up an X server timestamp for the current time
# by taking the time of day in milliseconds to 32-bit
# accuracy and then jiggering the type appropriately:
#
fun bogus_current_x_timestamp ()
=
{ time = time::get_current_time_utc (); # Current time
ms = time::to_milliseconds time; # in milliseconds since the Epoch
ms32 = large_int::(%) (ms, 256*256*256*256); # truncated to 32-bit accuracy
ms32 = one_word_unt::from_multiword_int ms32; # converted to 32-bit unsigned
ms32 = xserver_timestamp::XSERVER_TIMESTAMP ms32; # wrapped up as a
ms32 = xtypes::TIMESTAMP ms32; # proper X timestamp value.
ms32;
};
fun send_keyboard_key_press_xevent
(
XSESSION
{ xdisplay => dy::XDISPLAY { xsocket, ... },
default_screen_info => SCREEN_INFO { xscreen => dy::XSCREEN { root_window_id, ... }, ... },
...
}
)
{ window => window as WINDOW { window_id, ... }, # Window handling the keyboard-key press event.
keycode, # Keyboard key just "pressed".
point => point as xg::POINT { row, col } # Keypress location in local window coordinates.
}
=
{ # We need the keypress point in both
# local and screen coords:
#
trace .{ sprintf "xsession: send_keyboard_key_press_event/TOP window_point = { row %d, col %d }." row col; };
(window_point_to_screen_point window point)
->
xg::POINT { row => screen_row,
col => screen_col
};
trace .{ sprintf "xsession: send_keyboard_key_press_event/MID screen_point = { row %d, col %d }." screen_row screen_col; };
# For the semantics of these three fields see
# p27 http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
send_event_to = xt::SEND_EVENT_TO_WINDOW window_id;
propagate = FALSE;
event_mask = xt::EVENT_MASK 0u0;
#
# timestamp = xt::CURRENT_TIME; # I had thought the X server would fill this in for us, but apparently it passes it through. :-(
timestamp = bogus_current_x_timestamp (); # This won't sync with real X server timestamps, but I don't see a simple way to make it do so.
# Currently we never mix synthetic and natural X events, but this is a bug waiting to happen. XXX BUGGO FIXME.
root_window_id = root_window_id;
event_window_id = window_id; # Window handling the keyboard-key "press" event.
child_window_id = NULL; # We'll assume specified window is a leaf.
root_x = screen_col; # Mouse position on root window at time of keypress.
root_y = screen_row;
event_x = col; # Mouse position on recipient window at time of keypress.
event_y = row;
buttons = kab::make_mousebutton_state [ ]; # Mouse buttons state BEFORE keypress.
trace .{ "xsession: send_keyboard_key_press_event/YYY calling s2w::encode_send_keypress_xevent"; };
command
=
s2w::encode_send_keypress_xevent
{
send_event_to, propagate, event_mask,
timestamp, root_window_id, event_window_id, child_window_id, root_x, root_y, event_x, event_y, keycode, buttons
};
xok::send_xrequest xsocket command;
trace .{ "xsession: send_keyboard_key_press_event/BOT called s2w::encode_send_keypress_xevent -- DONE"; };
();
};
fun send_keyboard_key_release_xevent
(
XSESSION
{ xdisplay => dy::XDISPLAY { xsocket, ... },
default_screen_info => SCREEN_INFO { xscreen => dy::XSCREEN { root_window_id, ... }, ... },
...
}
)
{ window => window as WINDOW { window_id, ... }, # Window handling the keyboard-key release event.
keycode, # Keyboard key just "released".
point => point as xg::POINT { row, col } # Key release location in local window coordinates.
}
=
{ # We need the key release point in both
# local and screen coords:
#
trace .{ sprintf "xsession: send_keyboard_key_release_event/TOP window_point = { row %d, col %d }." row col; };
(window_point_to_screen_point window point)
->
xg::POINT { row => screen_row,
col => screen_col
};
trace .{ sprintf "xsession: send_keyboard_key_release_event/MID screen_point = { row %d, col %d }." screen_row screen_col; };
# For the semantics of these three fields see
# p27 http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
send_event_to = xt::SEND_EVENT_TO_WINDOW window_id;
propagate = FALSE;
event_mask = xt::EVENT_MASK 0u0;
#
# timestamp = xt::CURRENT_TIME; # I had thought the X server would fill this in for us, but apparently it passes it through. :-(
timestamp = bogus_current_x_timestamp (); # This won't sync with real X server timestamps, but I don't see a simple way to make it do so.
# Currently we never mix synthetic and natural X events, but this is a bug waiting to happen. XXX BUGGO FIXME.
root_window_id = root_window_id;
event_window_id = window_id; # Window handling the keyboard-key "release" event.
child_window_id = NULL; # We'll assume specified window is a leaf.
root_x = screen_col; # Mouse position on root window at time of key "release".
root_y = screen_row;
event_x = col; # Mouse position on recipient window at time of key "release".
event_y = row;
buttons = kab::make_mousebutton_state [ ]; # Mouse buttons state BEFORE key release.
trace .{ "xsession: send_keyboard_key_release_event/YYY calling s2w::encode_send_keyrelease_xevent"; };
command
=
s2w::encode_send_keyrelease_xevent
{
send_event_to, propagate, event_mask,
timestamp, root_window_id, event_window_id, child_window_id, root_x, root_y, event_x, event_y, keycode, buttons
};
xok::send_xrequest xsocket command;
trace .{ "xsession: send_keyboard_key_release_event/BOT called s2w::encode_send_keyrelease_xevent -- DONE"; };
();
};
fun send_mousebutton_press_xevent
(
XSESSION
{ xdisplay => dy::XDISPLAY { xsocket, ... },
default_screen_info => SCREEN_INFO { xscreen => dy::XSCREEN { root_window_id, ... }, ... },
...
}
)
{ window => window as WINDOW { window_id, ... }, # Window handling the mouse-button click event.
button, # Mouse button just "clicked" down.
point => point as xg::POINT { row, col } # Click location in local window coordinates.
}
=
{ # We need the clickpoint in both
# local and screen coords:
#
trace .{ sprintf "xsession: send_mousebutton_press_event/TOP window_point = { row %d, col %d }." row col; };
(window_point_to_screen_point window point)
->
xg::POINT { row => screen_row,
col => screen_col
};
trace .{ sprintf "xsession: send_mousebutton_press_event/MID screen_point = { row %d, col %d }." screen_row screen_col; };
# For the semantics of these three fields see
# p27 http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
send_event_to = xt::SEND_EVENT_TO_WINDOW window_id;
propagate = FALSE;
event_mask = xt::EVENT_MASK 0u0;
#
# timestamp = xt::CURRENT_TIME; # I had thought the X server would fill this in for us, but apparently it passes it through. :-(
timestamp = bogus_current_x_timestamp (); # This won't sync with real X server timestamps, but I don't see a simple way to make it do so.
# Currently we never mix synthetic and natural X events, but this is a bug waiting to happen. XXX BUGGO FIXME.
root_window_id = root_window_id;
event_window_id = window_id; # Window handling the mouse-button release event.
child_window_id = NULL; # We'll assume specified window is a leaf.
root_x = screen_col; # Mouse position on root window at time of button release.
root_y = screen_row;
event_x = col; # Mouse position on recipient window at time of button release.
event_y = row;
buttons = kab::make_mousebutton_state [ ]; # Mouse buttons state BEFORE button press.
trace .{ "xsession: send_mousebutton_press_event/YYY calling s2w::encode_send_buttonpress_xevent"; };
command
=
s2w::encode_send_buttonpress_xevent
{
send_event_to, propagate, event_mask,
timestamp, root_window_id, event_window_id, child_window_id, root_x, root_y, event_x, event_y, button, buttons
};
xok::send_xrequest xsocket command;
trace .{ "xsession: send_mousebutton_press_event/BOT called s2w::encode_send_buttonpress_xevent -- DONE"; };
();
};
fun send_mousebutton_release_xevent
(
XSESSION
{ xdisplay => dy::XDISPLAY { xsocket, ... },
default_screen_info => SCREEN_INFO { xscreen => dy::XSCREEN { root_window_id, ... }, ... },
...
}
)
{ window => window as WINDOW { window_id, ... }, # Window handling the mouse-button click event.
button, # Mouse button just "clicked" down.
point => point as xg::POINT { row, col } # Click location in local window coordinates.
}
=
{ # We need the clickpoint in both
# local and screen coords:
#
trace .{ sprintf "xsession: send_mousebutton_release_xevent/TOP window_point = { row %d, col %d }." row col; };
(window_point_to_screen_point window point)
->
xg::POINT { row => screen_row,
col => screen_col
};
trace .{ sprintf "xsession: send_mousebutton_release_xevent/MID screen_point = { row %d, col %d }." screen_row screen_col; };
# For the semantics of these three fields see
# p27 http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
send_event_to = xt::SEND_EVENT_TO_WINDOW window_id;
propagate = FALSE;
event_mask = xt::EVENT_MASK 0u0;
#
# timestamp = xt::CURRENT_TIME; # I had thought the X server would fill this in for us, but apparently it passes it through. :-(
timestamp = bogus_current_x_timestamp (); # This won't sync with real X server timestamps, but I don't see a simple way to make it do so.
# Currently we never mix synthetic and natural X events, but this is a bug waiting to happen. XXX BUGGO FIXME.
root_window_id = root_window_id;
event_window_id = window_id; # Window handling the mouse-button release event.
child_window_id = NULL; # We'll assume specified window is a leaf.
root_x = screen_col; # Mouse position on root window at time of button release.
root_y = screen_row;
event_x = col; # Mouse position on recipient window at time of button release.
event_y = row;
buttons = kab::make_mousebutton_state [ button ]; # Mouse buttons state BEFORE button release.
trace .{ "xsession: send_mousebutton_release_xevent/YYY calling s2w::encode_send_buttonpress_xevent"; };
command
=
s2w::encode_send_buttonrelease_xevent
{
send_event_to, propagate, event_mask,
timestamp, root_window_id, event_window_id, child_window_id, root_x, root_y, event_x, event_y, button, buttons
};
xok::send_xrequest xsocket command;
trace .{ "xsession: send_mousebutton_release_event/BOT called s2w::encode_send_buttonpress_xevent -- DONE"; };
();
};
fun send_mouse_motion_xevent
(
XSESSION
{ xdisplay => dy::XDISPLAY { xsocket, ... },
default_screen_info => SCREEN_INFO { xscreen => dy::XSCREEN { root_window_id, ... }, ... },
...
}
)
{ window => window as WINDOW { window_id, ... }, # Window handling the mouse-moution event.
buttons, # Mouse button(s) being dragged.
point => point as xg::POINT { row, col } # Motion location in local window coordinates.
}
=
{ # We need the clickpoint in both
# local and screen coords:
#
trace .{ sprintf "xsession: send_mouse_motion_xevent/TOP window_point = { row %d, col %d }." row col; };
(window_point_to_screen_point window point)
->
xg::POINT { row => screen_row,
col => screen_col
};
trace .{ sprintf "xsession: send_mouse_motion_xevent/MID screen_point = { row %d, col %d }." screen_row screen_col; };
# For the semantics of these three fields see
# p27 http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
send_event_to = xt::SEND_EVENT_TO_WINDOW window_id;
propagate = FALSE;
event_mask = xt::EVENT_MASK 0u0;
#
# timestamp = xt::CURRENT_TIME; # I had thought the X server would fill this in for us, but apparently it passes it through. :-(
timestamp = bogus_current_x_timestamp (); # This won't sync with real X server timestamps, but I don't see a simple way to make it do so.
# Currently we never mix synthetic and natural X events, but this is a bug waiting to happen. XXX BUGGO FIXME.
root_window_id = root_window_id;
event_window_id = window_id; # Window handling the mouse-button release event.
child_window_id = NULL; # We'll assume specified window is a leaf.
root_x = screen_col; # Mouse position on root window at time of button release.
root_y = screen_row;
event_x = col; # Mouse position on recipient window at time of button release.
event_y = row;
buttons = kab::make_mousebutton_state buttons; # Mouse buttons being dragged
trace .{ "xsession: send_mouse_motion_xevent/YYY calling s2w::encode_send_motionnotify_xevent"; };
command
=
s2w::encode_send_motionnotify_xevent
{
send_event_to, propagate, event_mask,
timestamp, root_window_id, event_window_id, child_window_id, root_x, root_y, event_x, event_y, buttons
};
xok::send_xrequest xsocket command;
trace .{ "xsession: send_mouse_motion_event/BOT called s2w::encode_send_motionnotify_xevent -- DONE"; };
();
};
fun send_''mouse_enter''_xevent
(
XSESSION
{ xdisplay => dy::XDISPLAY { xsocket, ... },
default_screen_info => SCREEN_INFO { xscreen => dy::XSCREEN { root_window_id, ... }, ... },
...
}
)
{ window => window as WINDOW { window_id, ... }, # Window handling the mouse-button click event.
point => point as xg::POINT { row, col } # Click location in local window coordinates.
}
=
{ # We need the point in both
# local and screen coords:
#
trace .{ sprintf "xsession: send_''mouse_enter''_xevent/TOP window_point = { row %d, col %d }." row col; };
(window_point_to_screen_point window point)
->
xg::POINT { row => screen_row,
col => screen_col
};
trace .{ sprintf "xsession: send_''mouse_enter''_xevent/MID screen_point = { row %d, col %d }." screen_row screen_col; };
# For the semantics of these three fields see
# p27 http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
send_event_to = xt::SEND_EVENT_TO_WINDOW window_id;
propagate = FALSE;
event_mask = xt::EVENT_MASK 0u0;
#
# timestamp = xt::CURRENT_TIME; # I had thought the X server would fill this in for us, but apparently it passes it through. :-(
timestamp = bogus_current_x_timestamp (); # This won't sync with real X server timestamps, but I don't see a simple way to make it do so.
# Currently we never mix synthetic and natural X events, but this is a bug waiting to happen. XXX BUGGO FIXME.
root_window_id = root_window_id;
event_window_id = window_id; # Window handling the mouse-button release event.
child_window_id = NULL; # We'll assume specified window is a leaf.
root_x = screen_col; # Mouse position on root window at time of button release.
root_y = screen_row;
event_x = col; # Mouse position on recipient window at time of button release.
event_y = row;
buttons = xt::MOUSEBUTTON_STATE 0u0;
trace .{ "xsession: send_''mouse_enter''_xevent/YYY calling s2w::encode_send_enternotify_xevent"; };
command
=
s2w::encode_send_enternotify_xevent
{
send_event_to, propagate, event_mask,
timestamp, root_window_id, event_window_id, child_window_id, root_x, root_y, event_x, event_y, buttons
};
xok::send_xrequest xsocket command;
trace .{ "xsession: send_''mouse_enter''_xevent/BOT called s2w::encode_send_enternotify_xevent -- DONE"; };
();
};
fun send_''mouse_leave''_xevent
(
XSESSION
{ xdisplay => dy::XDISPLAY { xsocket, ... },
default_screen_info => SCREEN_INFO { xscreen => dy::XSCREEN { root_window_id, ... }, ... },
...
}
)
{ window => window as WINDOW { window_id, ... }, # Window handling the mouse-button click event.
point => point as xg::POINT { row, col } # Click location in local window coordinates.
}
=
{ # We need the point in both
# local and screen coords:
#
trace .{ sprintf "xsession: send_''mouse_leave''_xevent/TOP window_point = { row %d, col %d }." row col; };
(window_point_to_screen_point window point)
->
xg::POINT { row => screen_row,
col => screen_col
};
trace .{ sprintf "xsession: send_''mouse_leave''_xevent/MID screen_point = { row %d, col %d }." screen_row screen_col; };
# For the semantics of these three fields see
# p27 http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
send_event_to = xt::SEND_EVENT_TO_WINDOW window_id;
propagate = FALSE;
event_mask = xt::EVENT_MASK 0u0;
#
# timestamp = xt::CURRENT_TIME; # I had thought the X server would fill this in for us, but apparently it passes it through. :-(
timestamp = bogus_current_x_timestamp (); # This won't sync with real X server timestamps, but I don't see a simple way to make it do so.
# Currently we never mix synthetic and natural X events, but this is a bug waiting to happen. XXX BUGGO FIXME.
root_window_id = root_window_id;
event_window_id = window_id; # Window handling the mouse-button release event.
child_window_id = NULL; # We'll assume specified window is a leaf.
root_x = screen_col; # Mouse position on root window at time of button release.
root_y = screen_row;
event_x = col; # Mouse position on recipient window at time of button release.
event_y = row;
buttons = xt::MOUSEBUTTON_STATE 0u0;
trace .{ "xsession: send_''mouse_leave''_xevent/YYY calling s2w::encode_send_leavenotify_xevent"; };
command
=
s2w::encode_send_leavenotify_xevent
{
send_event_to, propagate, event_mask,
timestamp, root_window_id, event_window_id, child_window_id, root_x, root_y, event_x, event_y, buttons
};
xok::send_xrequest xsocket command;
trace .{ "xsession: send_''mouse_leave''_xevent/BOT called s2w::encode_send_leavenotify_xevent -- DONE"; };
();
};
# Close the xsession.
# NOTE: there are probably other things
# that should go on here, such as notifying
# the xbuf_to_topwindow_xevent_router. XXX BUGGO FIXME
#
fun close_xsession (XSESSION { xdisplay, ... } )
=
{ # Threads will die left and right as we shut down,
# and scary warning messages will by default be
# logged to stdout, so suppress that to avoid
# spooking the user:
#
logger::disable thread_deathwatch::logging;
display::close_display xdisplay;
};
# Return the maximum request size
# supported by the display:
#
fun max_request_length (XSESSION { xdisplay=>dy::XDISPLAY { max_request_length, ... }, ... } )
=
max_request_length;
# Atom operations:
#
stipulate
fun wrap_atom_op f (XSESSION { atom_imp, ... } )
=
f atom_imp;
herein
make_atom = wrap_atom_op ai::make_atom;
find_atom = wrap_atom_op ai::find_atom;
atom_to_string = wrap_atom_op ai::atom_to_string;
end;
# Font operations:
#
fun open_font (XSESSION { font_imp, ... } )
=
font_imp::open_a_font font_imp;
fun default_screen_of (xsession as XSESSION { default_screen_info, ... } )
=
SCREEN { xsession, screen_info => default_screen_info };
fun get_''gui_startup_complete''_oneshot_of_xsession (xsession as XSESSION { xsocket_to_topwindow_router, ... } )
=
s2t::get_''gui_startup_complete''_oneshot_of
#
xsocket_to_topwindow_router;
fun screens_of (xsession as XSESSION { screens, ... } )
=
map (fn s = SCREEN { xsession, screen_info => s })
screens;
fun ring_bell xsession percent
=
send_xrequest xsession
(value_to_wire::encode_bell { percent => int::min (100, int::max(-100, percent)) } );
# Screen functions:
#
color_of_screen
=
cs::get_color;
fun xsession_of_screen (SCREEN { xsession, ... } )
=
xsession;
# Additions by ddeboer, May 2004.
# Dusty deBoer, KSU CIS 705, Spring 2004.
# Return the root window of a screen.
# This is needed in obtaining strings from xrdb,
# as they are stored in a property of the root window:
#
fun root_window_of_screen (SCREEN { screen_info => SCREEN_INFO { xscreen => dy::XSCREEN { root_window_id, ... }, ... }, ... } )
=
root_window_id;
# End additions by ddeboer
fun size_of_screen (SCREEN { screen_info => SCREEN_INFO { xscreen => dy::XSCREEN { size_in_pixels, ... }, ... }, ... } )
=
size_in_pixels;
fun mm_size_of_screen (SCREEN { screen_info => SCREEN_INFO { xscreen => dy::XSCREEN { size_in_mm, ... }, ... }, ... } )
=
size_in_mm;
fun depth_of_screen (SCREEN { screen_info => SCREEN_INFO { xscreen => dy::XSCREEN { root_visual, ... }, ... }, ... } )
=
dy::depth_of_visual root_visual;
fun display_class_of_screen (SCREEN { screen_info => SCREEN_INFO { xscreen => dy::XSCREEN { root_visual, ... }, ... }, ... } )
=
case (dy::display_class_of_visual root_visual)
THE c => c;
_ => xgripe::impossible "[xsession::display_class_of_screen: bogus root visual]";
esac;
# Return the pen-to-gcontext and draw imps
# for given depth on given screen:
#
fun screen_pen_and_draw_imps_for_depth (SCREEN { screen_info => SCREEN_INFO { per_depth_pen_and_draw_imps, ... }, ... }, given_depth)
=
search per_depth_pen_and_draw_imps
where
fun search []
=>
xgripe::xerror "invalid depth for screen";
search ((sd as SCREEN_PEN_AND_DRAW_IMPS { depth, ... } ) ! rest)
=>
if (depth == given_depth) sd;
else search rest;
fi;
end;
end;
fun keysym_to_keycode (XSESSION { keymap_imp, ... }, keysym)
=
ki::keysym_to_keycode (keymap_imp, keysym);
}; # package xsession
end; # stipulate.