## xevent-to-widget-ximp.pkg
#
# For each toplevel window, which is to say
# at the root of each widget tree, we need
# a thread which accepts xevents from
#
# src/lib/x-kit/xclient/src/window/xsocket-to-hostwindow-router-old.pkg#
# and passes them them on down the widgettree.
#
# That's our job here.
#
# For the big picture see the diagram in
# src/lib/x-kit/xclient/src/window/xclient-ximps.pkg# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublibstipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package xet = xevent_types; # xevent_types is from src/lib/x-kit/xclient/src/wire/xevent-types.pkg package kb = keys_and_buttons; # keys_and_buttons is from src/lib/x-kit/xclient/src/wire/keys-and-buttons.pkg package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkg #
package dy = display; # display is from src/lib/x-kit/xclient/src/wire/display.pkg package di = xserver_ximp; # xserver_ximp is from src/lib/x-kit/xclient/src/window/xserver-ximp.pkg package w2x = windowsystem_to_xserver; # windowsystem_to_xserver is from src/lib/x-kit/xclient/src/window/windowsystem-to-xserver.pkg# package dt = draw_types; # draw_types is from src/lib/x-kit/xclient/src/window/draw-types.pkg package ki = keymap_ximp; # keymap_ximp is from src/lib/x-kit/xclient/src/window/keymap-ximp.pkg# package r2k = xevent_router_to_keymap; # xevent_router_to_keymap is from src/lib/x-kit/xclient/src/window/xevent-router-to-keymap.pkg package sn = xsession_junk; # xsession_junk is from src/lib/x-kit/xclient/src/window/xsession-junk.pkg package s2t = xevent_router_ximp; # xevent_router_ximp is from src/lib/x-kit/xclient/src/window/xevent-router-ximp.pkg package x2w = windowsystem_to_xevent_router; # windowsystem_to_xevent_router is from src/lib/x-kit/xclient/src/window/windowsystem-to-xevent-router.pkg package wc = widget_cable; # widget_cable is from src/lib/x-kit/xclient/src/window/widget-cable.pkgherein
package xevent_to_widget_ximp
: (weak) Xevent_To_Widget_Ximp # Xevent_To_Widget_Ximp is from src/lib/x-kit/xclient/src/window/xevent-to-widget-ximp.api {
trace = xtr::log_if xtr::hostwindow_to_widget_router_tracing 0; # Conditionally write strings to tracing.log or whatever.
fun foo () = ();
# The top-level window (usually a shell widget)
# should never pass on CO message # "CO" == "command out"
#
fun make_co_thread co_event
=
make_thread "widget-cable root-end CO eater" {.
#
block_until_mailop_fires co_event;
xgripe::impossible("[widgetcable-rootend: unexpected CO message]");
};
fun make_router
( { xevent_router_to_keymap, ... }: sn::Xsession,
xevent_in',
drawimp_mappedstate_slot,
top_window
)
=
{ make_descendant_window
=
{ top_window -> { screen, per_depth_imps, windowsystem_to_xserver, ... }: sn::Window;
#
\\ window_id
=
{ window_id, screen, per_depth_imps, windowsystem_to_xserver, subwindow_or_view => NULL }: sn::Window;
};
(wc::make_widget_cable ())
->
{ kidplug, momplug };
my (route_other_envelope', route_keyboard_envelope', route_mouse_envelope')
=
{ momplug -> wc::MOMPLUG { other_sink, keyboard_sink, mouse_sink, from_kid' };
#
make_co_thread from_kid';
(other_sink, keyboard_sink, mouse_sink);
};
keycode_to_keysym = xevent_router_to_keymap.keycode_to_keysym;
stipulate
seqn = REF 0;
herein
fun stuff_envelope (route, contents)
=
{ n = *seqn;
seqn := n+1;
wc::ENVELOPE { route, seqn=>n, contents };
};
end;
# Create mailslot to pass client messages
# to the application.
#
# This appears is a 2005 dusty deboer hack described
# in the "Library: Deletion Events" section of
#
# http://people.cis.ksu.edu/~ddeboer/eXene.html
#
# Receipt of (any) CLIENT_MESSAGE X event is signaled
# (see fun route_xevent below) via this slot
# and can be waited on via HOSTWINDOW.delete_slot
# -- see delete_mailop in src/lib/x-kit/widget/old/basic/hostwindow.api #
# We never send a CLIENT_MESSAGE, nor does any existing
# code reference the delete_mailop. However, the window
# manager
#
wm_window_delete_slot = make_mailslot ();
fun do_key (make_msg, key_event)
=
route_keyboard_envelope' (make_msg (keycode_to_keysym key_event));
fun do_button_press (path, info: xet::Button_Xevtinfo)
=
{ info -> { mouse_button, event_point, root_point, timestamp, mousebuttons_state, ... };
mail = if (kb::no_mousebuttons_set mousebuttons_state)
#
wc::MOUSE_FIRST_DOWN
{
mouse_button,
window_point => event_point,
screen_point => root_point,
timestamp
};
else
wc::MOUSE_DOWN
{
mouse_button,
window_point => event_point,
screen_point => root_point,
# invert button so that the state is post-transition
state => kb::invert_button_in_mousebutton_state (mousebuttons_state, mouse_button),
timestamp
};
fi;
route_mouse_envelope' (stuff_envelope (path, mail));
};
fun do_button_release (path, info: xet::Button_Xevtinfo)
=
route_mouse_envelope' (stuff_envelope (path, msg))
where
info -> { mouse_button, event_point, root_point, timestamp, mousebuttons_state, ... };
state = kb::invert_button_in_mousebutton_state (mousebuttons_state, mouse_button);
msg = if (kb::no_mousebuttons_set state)
#
wc::MOUSE_LAST_UP
{
mouse_button,
window_point => event_point,
screen_point => root_point,
timestamp
};
else
wc::MOUSE_UP
{
mouse_button,
window_point => event_point,
screen_point => root_point,
state,
timestamp
};
fi;
end;
# An always-ready mailop producing void:
#
always_void
=
always' ();
fun do_config_sync (path, config_msg)
=
always_void
==>
{. block_until_mailop_fires (route_mouse_envelope' (stuff_envelope (path, wc::MOUSE_CONFIG_SYNC)));
block_until_mailop_fires (route_keyboard_envelope' (stuff_envelope (path, wc::KEY_CONFIG_SYNC)));
block_until_mailop_fires (route_other_envelope' (stuff_envelope (path, config_msg)));
};
fun route_xevent (path, xet::x::KEY_PRESS arg)
=>
{
do_key (\\ x = stuff_envelope (path, wc::KEY_PRESS x), arg);
};
route_xevent (path, xet::x::KEY_RELEASE arg)
=>
{
do_key (\\ x = stuff_envelope (path, wc::KEY_RELEASE x), arg);
};
route_xevent (path, xet::x::BUTTON_PRESS arg)
=>
{
do_button_press (path, arg);
};
route_xevent (path, xet::x::BUTTON_RELEASE arg)
=>
{
do_button_release (path, arg);
};
route_xevent (path, xet::x::MOTION_NOTIFY { event_point, root_point, timestamp, ... } )
=>
route_mouse_envelope' (stuff_envelope (path, wc::MOUSE_MOTION { window_point=>event_point, screen_point=>root_point, timestamp } ));
route_xevent (path, xet::x::ENTER_NOTIFY { event_point, root_point, timestamp, ... } )
=>
route_mouse_envelope' (stuff_envelope (path, wc::MOUSE_ENTER { window_point=>event_point, screen_point=>root_point, timestamp } ));
route_xevent (path, xet::x::LEAVE_NOTIFY { event_point, root_point, timestamp, ... } )
=>
route_mouse_envelope' (stuff_envelope (path, wc::MOUSE_LEAVE { window_point=>event_point, screen_point=>root_point, timestamp } ));
/*******
| route_xevent (_, xet::x::FOCUS_IN {... } ) = ()
| route_xevent (_, xet::x::FOCUS_OUT {... } ) = ()
| route_xevent (_, xet::x::KEYMAP_NOTIFY {... } ) = ()
******/
route_xevent (path, xet::x::EXPOSE { boxes, ... } )
=>
{
trace {. "route_xevent: Handling EXPOSE"; };
route_other_envelope' (stuff_envelope (path, wc::ETC_REDRAW boxes));
};
/*******
| route_xevent (_, xet::x::GRAPHICS_EXPOSE {... } ) = ()
| route_xevent (_, xet::x::NO_EXPOSE {... } ) = ()
| route_xevent (_, xet::x::VISIBILITY_NOTIFY _) = ()
******/
route_xevent (path, xet::x::CREATE_NOTIFY { parent_window_id, created_window_id, ... } )
=>
{
trace {. "route_xevent: Handling CREATE_NOTIFY"; };
do_config_sync (path, wc::ETC_CHILD_BIRTH (make_descendant_window created_window_id));
};
route_xevent (path, xet::x::DESTROY_NOTIFY { destroyed_window_id, event_window_id, ... } )
=>
destroyed_window_id == event_window_id
##
?? route_other_envelope' (stuff_envelope (path, wc::ETC_OWN_DEATH))
:: do_config_sync (path, wc::ETC_CHILD_DEATH (make_descendant_window destroyed_window_id));
route_xevent (x2w::ENVELOPE_ROUTE_END _, xet::x::UNMAP_NOTIFY _)
=>
always_void
==>
{. put_in_mailslot (drawimp_mappedstate_slot, w2x::s::HOSTWINDOW_IS_NOW_UNMAPPED); };
route_xevent (_, xet::x::UNMAP_NOTIFY _)
=>
always_void;
route_xevent (x2w::ENVELOPE_ROUTE_END _, xet::x::MAP_NOTIFY _)
=>
always_void
==>
{. put_in_mailslot (drawimp_mappedstate_slot, w2x::s::HOSTWINDOW_IS_NOW_MAPPED); };
route_xevent (_, xet::x::MAP_NOTIFY _)
=>
{
trace {. "route_xevent: 'Handling' MAP_NOTIFY via always_void"; };
always_void;
};
/*******
| route_xevent (_, xet::x::MAP_REQUEST {... } ) = ()
| route_xevent (_, xet::x::REPARENT_NOTIFY {... } ) = ()
******/
route_xevent (path, xet::x::CONFIGURE_NOTIFY { box, ... } )
=>
route_other_envelope' (stuff_envelope (path, wc::ETC_RESIZE box));
/*******
| route_xevent (_, xet::x::ConfigureRequest {... } ) = ()
| route_xevent (_, xet::x::GravityNotify {... } ) = ()
| route_xevent (_, xet::x::ResizeRequest {... } ) = ()
| route_xevent (_, xet::x::CirculateNotify {... } ) = ()
| route_xevent (_, xet::x::CirculateRequest {... } ) = ()
| route_xevent (_, xet::x::PropertyNotify {... } ) = ()
| route_xevent (_, xet::x::SelectionClear {... } ) = ()
| route_xevent (_, xet::x::SelectionRequest {... } ) = ()
| route_xevent (_, xet::x::SelectionNotify {... } ) = ()
| route_xevent (_, xet::x::ColormapNotify {... } ) = ()
******/
/****** modification, ddeboer, Jul 2004: route this event when delete.
from ..protocol/xevent-types.pkg:
... CLIENT_MESSAGE_XEVENT of {
window: window_id,
type: atom, the type of the message
value: raw_data the message value
}
*/
route_xevent (_, xet::x::CLIENT_MESSAGE { window_id, type, ... } )
=>
always_void
==>
{. put_in_mailslot (wm_window_delete_slot, ()); };
#
# In principle we might here have received
# any of the following window manager messages:
#
# WM_ACCEPT_FOCUS -- See p33 of http://mythryl.org/pub/exene/icccm.pdf
# WM_DELETE_WINDOW -- See p43 (S4.2.8.1) of http://mythryl.org/pub/exene/icccm.pdf
# WM_SAVE_YOURSELF -- See p61 of http://mythryl.org/pub/exene/icccm.pdf (Obsolete -- use newer session management support.)
#
# However, we have only registered support for
# WM_DELETE_WINDOW so at present we presume
# that is what we have, without even checking.
#
# This is a 2005 dusty deboer hack described in
#
# http://people.cis.ksu.edu/~ddeboer/eXene.html
#
# When the user clicks on our windowframe close button,
# the window manager sends us a WM_DELETE_WINDOW X ClientEvent.
#
# It does this because we advertised support for the WM_DELETE_WINDOW
# ICCCM protocol in the set_protocols() fn in
#
# src/lib/x-kit/widget/old/basic/hostwindow.pkg #
# -- otherwise it would just summarily kill our X window
# and X socket connection.
#
# The window manager sends us WM_DELETE_WINDOW messages
# when the user clicks on the windowframe close button.
#
# WM_DELETE_WINDOW messages from the window manager via the
# delete_mailop
# in
# src/lib/x-kit/widget/old/basic/hostwindow.api #
# No existing code sends a CLIENT_MESSAGE,
# nor does any existing code reference delete_mailop.
# * end mod ***
route_xevent (_, event)
=>
always_void
==>
{. trace {. cat [ "[hostwindow_to_widget_router::route_xevent: unexpected event ", xevent_to_string::xevent_name event, "]" ]; };
};
end; # fun route_xevent
# +DEBUG
fun debug_router (result as (_, xevent))
=
{ trace {. cat [ "topwin2widget: get ", xevent_to_string::xevent_name xevent ]; };
result;
};
# -DEBUG
fun router ([], [])
=>
router ([debug_router (block_until_mailop_fires xevent_in')], []);
router ([], l)
=>
router (reverse l, []);
router (front as (msg_out ! r), rear)
=>
do_one_mailop [
xevent_in'
==>
(\\ result
=
router (front, (debug_router result) ! rear)),
route_xevent msg_out
==>
{. router (r, rear); }
];
end;
( kidplug,
(\\ pending = router (pending, [])),
wm_window_delete_slot
);
}; # fun make_router
# Create the X-event-router imp and draw_imp
# for a top-level window, returning the
# kidplug and hostwindow.
#
# This function is called (only) from
#
# make_simple_top_window
# make_simple_popup_window
# make_transient_window
# in
# src/lib/x-kit/xclient/src/window/window-old.pkg #
# fun make_hostwindow_to_widget_router
# (
# screen as { xsession, ... }: sn::Screen,
# per_depth_imps as { windowsystem_to_xserver, ... }: sn::Per_Depth_Imps,
# window_id,
# site
# )
# =
# { xsession -> { xdisplay as { xsocket, ... }: dy::Xdisplay, xsocket_to_hostwindow_router, ... }: sn::Xsession;
# #
# drawimp_mappedstate_slot
# =
# make_mailslot ();
#
# # trace {. "XYZZY make_hostwindow_to_widget_router: Doing make_draw_imp"; };
# to_hostwindow_drawimp
# =
# di::make_draw_imp
# (
# take_from_mailslot' drawimp_mappedstate_slot,
# pen_cache,
# # ========= XXXX BUGGO FIXME sharing pen_caches means we really do need mutual exclusion
# xsocket
# );
# # trace {. "XYZZY make_hostwindow_to_widget_router: Done make_draw_imp"; };
#
# xevent_in' # We receive X events via this mailop.
# =
# s2t::note_new_hostwindow
# (
# xsocket_to_hostwindow_router,
# window_id,
# site
# );
#
# top_window
# =
# { window_id, screen, per_depth_imps, to_hostwindow_drawimp }: sn::Window;
#
# my (kidplug, router, wm_window_delete_slot)
# =
# make_router (xsession, xevent_in', drawimp_mappedstate_slot, top_window);
#
# fun init_router ()
# =
# {
# fun loop buf
# =
# case (block_until_mailop_fires xevent_in')
# #
# arg as (_, xet::x::EXPOSE _)
# =>
# {
# /* DEBUG */ # trace {. "init_router: ExposeEvt"; };
# put_in_mailslot (drawimp_mappedstate_slot, di::s::FIRST_EXPOSE);
# /* DEBUG */ # trace {. "init_router: DM_FirstExpose sent"; };
# (arg ! buf);
# };
#
# arg => loop (arg ! buf);
# esac;
#
# /* DEBUG */ # trace {. cat ["init_router: window_id = ", xt::xid_to_string window_id]; };
# router (reverse (loop []));
# /* DEBUG */ # trace {. "init_router: go"; };
# };
#
# xtr::make_thread "topwin_to_widget" init_router;
#
#
# (kidplug, top_window, wm_window_delete_slot);
# }; # fun make_hostwindow_to_widget_router
}; # package toplevel_window
end;