## xsocket-to-topwindow-router.pkg
#
# Primary functionality
# =====================
#
# For the big picture, see the dataflow diagram in:
#
# src/lib/x-kit/xclient/pkg/window/xsession.pkg#
# We receive X events from the xsession xbuf_imp
# and decide what action to take for them. The
# xbuf_imp just breaks the X event bytestream up
# into individual messages; we are the first link
# in the chain which actually responds to X events
# on a semantic level.
#
# Typically we route an X event to the toplevel
# window containing the relevant widget. More
# precisely, to the topwindow_to_widget_router
# instance for that topwindow -- see
#
# src/lib/x-kit/xclient/pkg/window/topwindow-to-widget-router.pkg#
# To do this we maintain a
#
# window_id_to_window_info_map
#
# which tracks all windows created by the application,
# keyed by their associated X-server IDs (xids), so that
# we can translate the xid in the event to the proper
# topwindow_to_widget_router input slot for delivery.
#
# In particular we track, for each window, the route
# needed to reach it down the window hierarchy, and
# deliver X events down that route, thus giving each
# ancestor of the target widget a chance to rewrite
# the event.
#
# We find out about newly created toplevel windows via our
#
# note_new_topwindow
#
# fn, which is called by the topwindow-creation functions
#
# make_simple_top_window
# make_simple_popup_window
# make_transient_window
# in
# src/lib/x-kit/xclient/pkg/window/window.pkg#
# We find out about newly created subwindows via
# CREATE_NOTIFY
# xevents from the X server, and about destroyed
# windows (toplevel and subwindow both) via
# DESTROY_NOTIFY
# xevents from the X server.
#
# There are also a few X events which we divert to
# specialized imps for processing:
#
# o The following three X events get redirected
# to our selection imp:
# SELECTION_CLEAR
# SELECTION_REQUEST
# SELECTION_NOTIFY
#
# o The following X events get redirected
# to our property imp:
# PROPERTY_NOTIFY
#
#
# Secondary functionality
# =======================
#
# This file also implements a facility to
# freeze selected windows, with draw commands
# to them queueing up until they are unlocked:
# See make_overlay_buffer in
# src/lib/x-kit/xclient/pkg/window/draw-imp.pkg #
# The idea might have been to allow XOR-implemented
# rubber-banding selection to work without anomalies
# due to the window contents changing between draw
# and undraw calls.
#
# The lock_window_tree entrypoint is called
# nowhere in the codebase, so this is apparently
# code that was just being phased in when
# development ceased.
#
# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib# TODO XXX BUGGO FIXME
# - refresh the keymap on ModifierMappingNotifyXEvt and KeyboardMappingNotifyXEvt
# events.
# - think about the relation of locks and changes in the tree structure
# also locking already locked windows.
stipulate
include threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/pkg/wire/xtypes.pkg package et = event_types; # event_types is from src/lib/x-kit/xclient/pkg/wire/event-types.pkg package dy = display; # display is from src/lib/x-kit/xclient/pkg/wire/display.pkg package xok = xsocket; # xsocket is from src/lib/x-kit/xclient/pkg/wire/xsocket.pkg package xg = xgeometry; # xgeometry is from src/lib/std/2d/xgeometry.pkg package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/pkg/stuff/xlogger.pkgherein
package xsocket_to_topwindow_router
: (weak) Xsocket_To_Topwindow_Router # Xsocket_To_Topwindow_Router is from src/lib/x-kit/xclient/pkg/window/xsocket-to-topwindow-router.api {
trace = xtr::log_if xtr::xsocket_to_topwindow_router_tracing; # Conditionally write strings to tracing.log or whatever.
Envelope_Route
= ENVELOPE_ROUTE_END xt::Window_Id
| ENVELOPE_ROUTE (xt::Window_Id, Envelope_Route)
;
stipulate
package plea {
#
Mail
= NOTE_NEW_TOPWINDOW (xt::Window_Id, xg::Window_Site)
| GET_WINDOW_SITE (xt::Window_Id, /* reply_oneshot: */ Oneshot_Maildrop(xg::Box))
#
| LOCK_WINDOW xt::Window_Id
| UNLOCK_WINDOW xt::Window_Id
| IS_WINDOW_LOCKED xt::Window_Id
#
| GET_''SEEN_FIRST_EXPOSE''_ONESHOT (xt::Window_Id, /* reply_oneshot: */ Oneshot_Maildrop( Null_Or(Oneshot_Maildrop(Void))) )
| NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT (xt::Window_Id, /* reply_oneshot: */ Oneshot_Maildrop( Void ))
#
| GET_''GUI_STARTUP_COMPLETE''_ONESHOT /* reply_oneshot: */ Oneshot_Maildrop( Oneshot_Maildrop(Void) )
;
};
Window_Info
=
WINDOW_INFO
{
window_id: xt::Window_Id, # 29-bit X id for this particular window.
route: Envelope_Route, # Path needed to reach this window, starting at its topwindow.
parent_info: Null_Or( Window_Info ),
#
children: Ref( List(Window_Info) ),
lock: Ref( Bool ),
site: Ref( xg::Box ),
#
to_topwindow_slot: Mailslot( (Envelope_Route, et::x::Event) ), # Where to send events headed for this window.
#
seen_first_expose: Ref( Bool ), # We set this TRUE on first EXPOSE event.
seen_first_expose_oneshot: Ref( Null_Or(Oneshot_Maildrop(Void)) ) # We set this on first EXPOSE event.
};
# The seen_first_expose* stuff is part of the
# infrastructure allowing a widget client to wait
# until the widget is fully operational before
# submitting requests to it. We presume that a
# widget is operational when we see an EXPOSE
# x event for it -- it had better be!
#
# See also seen_first_redraw_slot_of in
# src/lib/x-kit/widget/basic/widget.api # The various things we can
# do with a given X event:
#
Xevent_Action
#
= SEND_TO_WINDOW xt::Window_Id # Forward event to given window via all of its ancestors from topwindow down.
| NOTE_SITE_CHANGE_AND_SEND_TO_WINDOW (xt::Window_Id, xg::Box) # Note new size+position of window, then forward event normally.
| NOTE_EXPOSE_AND_SEND_TO_WINDOW xt::Window_Id # Note EXPOSE (if first for window) then forward event normally.
| NOTE_WINDOW_DESTRUCTION xt::Window_Id
| SEND_TO_KEYMAP_IMP # This appears to be unused at present.
| SEND_TO_WINDOW_PROPERTY_IMP
| SEND_TO_SELECTION_IMP
| SEND_TO_ALL_WINDOWS # So everyone hears about changes in modifier key, keyboard and pointer mappings.
| IGNORE
| NOTE_NEW_WINDOW
{ parent_window_id: xt::Window_Id,
created_window_id: xt::Window_Id,
box: xg::Box
}
;
# Discard instances of an X-event that
# are the product of SubstructureNotify,
# instead of StructureNotify.
#
fun ignore_substructure_notify_xevents (window_id1, window_id2)
=
if (window_id1 == window_id2) SEND_TO_WINDOW window_id1;
else IGNORE;
fi;
# Decide what action to take for given X event. Here
#
# event_window_id
#
# is the window corresponding to the widget which
# should actually handle the event, as determined
# by the X server; the X server algorithm is
# described on pages 76-77 of
#
# http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
fun pick_xevent_action (et::x::KEY_PRESS { event_window_id, ... } ) => SEND_TO_WINDOW event_window_id;
pick_xevent_action (et::x::KEY_RELEASE { event_window_id, ... } ) => SEND_TO_WINDOW event_window_id;
# pick_xevent_action (et::x::BUTTON_PRESS { event_window_id, ... } ) => SEND_TO_WINDOW event_window_id;
# pick_xevent_action (et::x::BUTTON_RELEASE { event_window_id, ... } ) => SEND_TO_WINDOW event_window_id;
pick_xevent_action (et::x::BUTTON_PRESS { event_window_id, ... } ) => { trace .{ sprintf "pick_xevent_action/BUTTON_PRESS: event_window_id s=%s" (xtype_to_string::xid_to_string event_window_id); };
SEND_TO_WINDOW event_window_id; };
pick_xevent_action (et::x::BUTTON_RELEASE { event_window_id, ... } ) => { trace .{ sprintf "pick_xevent_action/BUTTON_RELEASE: event_window_id s=%s" (xtype_to_string::xid_to_string event_window_id); };
SEND_TO_WINDOW event_window_id; };
pick_xevent_action (et::x::MOTION_NOTIFY { event_window_id, ... } ) => SEND_TO_WINDOW event_window_id;
pick_xevent_action (et::x::ENTER_NOTIFY { event_window_id, ... } ) => SEND_TO_WINDOW event_window_id;
pick_xevent_action (et::x::LEAVE_NOTIFY { event_window_id, ... } ) => SEND_TO_WINDOW event_window_id;
pick_xevent_action (et::x::FOCUS_IN { event_window_id, ... } ) => SEND_TO_WINDOW event_window_id;
pick_xevent_action (et::x::FOCUS_OUT { event_window_id, ... } ) => SEND_TO_WINDOW event_window_id;
# pick_xevent_action (et::x::KeymapNotify {, ... } ) =
# pick_xevent_action (et::x::GraphicsExpose ??
# pick_xevent_action (et::x::NoExpose {, ... } ) =
# pick_xevent_action (et::x::MapRequest {, ... } ) =
# pick_xevent_action (et::x::ConfigureRequest {, ... } ) =
# pick_xevent_action (et::x::ResizeRequest {, ... } ) =
# pick_xevent_action (et::x::CirculateRequest {, ... } ) =
pick_xevent_action (et::x::EXPOSE { exposed_window_id, ... } ) => NOTE_EXPOSE_AND_SEND_TO_WINDOW exposed_window_id;
pick_xevent_action (et::x::VISIBILITY_NOTIFY { changed_window_id, ... } ) => SEND_TO_WINDOW changed_window_id;
pick_xevent_action (et::x::CREATE_NOTIFY { parent_window_id, created_window_id, box, ... } )
=>
{
trace .{ sprintf "pick_xevent_action/CREATE_NOTIFY: parent_window_id s=%s created_window_id x=%s" (xtype_to_string::xid_to_string parent_window_id) (xtype_to_string::xid_to_string created_window_id); };
NOTE_NEW_WINDOW { parent_window_id, created_window_id, box };
};
pick_xevent_action (et::x::DESTROY_NOTIFY { event_window_id, destroyed_window_id, ... } )
=>
event_window_id == destroyed_window_id
##
?? NOTE_WINDOW_DESTRUCTION event_window_id # Remove window from registry.
:: SEND_TO_WINDOW event_window_id; # Report to parent that child is dead.
pick_xevent_action (et::x::UNMAP_NOTIFY { event_window_id, unmapped_window_id, ... } )
=>
ignore_substructure_notify_xevents (event_window_id, unmapped_window_id);
pick_xevent_action (et::x::MAP_NOTIFY { event_window_id, mapped_window_id, ... } )
=>
ignore_substructure_notify_xevents (event_window_id, mapped_window_id);
pick_xevent_action (et::x::REPARENT_NOTIFY _)
=>
IGNORE;
pick_xevent_action (et::x::CONFIGURE_NOTIFY { event_window_id, configured_window_id, box, ... } )
=>
case (ignore_substructure_notify_xevents (event_window_id, configured_window_id))
#
SEND_TO_WINDOW _ => NOTE_SITE_CHANGE_AND_SEND_TO_WINDOW (configured_window_id, box);
_ => IGNORE;
esac;
pick_xevent_action (et::x::GRAVITY_NOTIFY { event_window_id, moved_window_id, ... } )
=>
ignore_substructure_notify_xevents (event_window_id, moved_window_id);
pick_xevent_action (et::x::CIRCULATE_NOTIFY { event_window_id, circulated_window_id, ... } )
=>
ignore_substructure_notify_xevents (event_window_id, circulated_window_id);
pick_xevent_action (et::x::PROPERTY_NOTIFY _) => SEND_TO_WINDOW_PROPERTY_IMP; # We may have other uses of PropertyNotify someday.
pick_xevent_action (et::x::SELECTION_CLEAR _) => SEND_TO_SELECTION_IMP;
pick_xevent_action (et::x::SELECTION_REQUEST _) => SEND_TO_SELECTION_IMP;
pick_xevent_action (et::x::SELECTION_NOTIFY _) => SEND_TO_SELECTION_IMP;
pick_xevent_action (et::x::COLORMAP_NOTIFY { window_id, ... } ) => SEND_TO_WINDOW window_id;
pick_xevent_action (et::x::CLIENT_MESSAGE { window_id, ... } ) => SEND_TO_WINDOW window_id;
pick_xevent_action et::x::MODIFIER_MAPPING_NOTIFY => SEND_TO_ALL_WINDOWS;
pick_xevent_action (et::x::KEYBOARD_MAPPING_NOTIFY _) => SEND_TO_ALL_WINDOWS;
pick_xevent_action et::x::POINTER_MAPPING_NOTIFY => SEND_TO_ALL_WINDOWS;
pick_xevent_action e => {
xgripe::warning (string::cat [
"[xsocket-to-topwin: unexpected ", xevent_to_string::xevent_name e, " event]\n"]);
IGNORE;};
end;
# +DEBUG
# Define a tracelogging version of
#
# pick_xevent_action
#
stipulate
xid_to_string = xtype_to_string::xid_to_string;
fun xevent_action_to_string (SEND_TO_WINDOW w)
=>
("SEND_TO_WINDOW(" + xid_to_string w + ")");
xevent_action_to_string (NOTE_EXPOSE_AND_SEND_TO_WINDOW w)
=>
("NOTE_EXPOSE_AND_SEND_TO_WINDOW(" + xid_to_string w + ")");
xevent_action_to_string (NOTE_SITE_CHANGE_AND_SEND_TO_WINDOW (w,_))
=>
("NOTE_SITE_CHANGE_AND_SEND_TO_WINDOW(" + xid_to_string w + ")");
xevent_action_to_string (NOTE_NEW_WINDOW { parent_window_id, created_window_id, box } )
=>
string::cat
[
"NOTE_NEW_WINDOW { parent=", xid_to_string parent_window_id,
", new_window=", xid_to_string created_window_id,
"}"
];
xevent_action_to_string (NOTE_WINDOW_DESTRUCTION w) => ("NOTE_WINDOW_DESTRUCTION(" + xid_to_string w + ")");
xevent_action_to_string SEND_TO_KEYMAP_IMP => "SEND_TO_KEYMAP_IMP";
xevent_action_to_string SEND_TO_WINDOW_PROPERTY_IMP => "SEND_TO_WINDOW_PROPERTY_IMP";
xevent_action_to_string SEND_TO_SELECTION_IMP => "SEND_TO_SELECTION_IMP";
xevent_action_to_string SEND_TO_ALL_WINDOWS => "SEND_TO_ALL_WINDOWS";
xevent_action_to_string IGNORE => "IGNORE";
end;
herein
pick_xevent_action
=
fn xevent
=
{ xevent_action = pick_xevent_action xevent;
trace .{
#
cat [ "xsocket_to_topwindow_router: ", xevent_to_string::xevent_name xevent,
" => ", xevent_action_to_string xevent_action
];
};
xevent_action;
};
end;
# -DEBUG
herein
Xsocket_To_Topwindow_Router
=
XSOCKET_TO_TOPWINDOW_ROUTER
{
plea_slot: Mailslot( plea::Mail ),
reply_slot: Mailslot( Mailop( (Envelope_Route, et::x::Event) ) ),
lock_slot: Mailslot( Bool )
};
stipulate
fun set_window_subtree_locks_to
(bool: Bool)
=
set
where
fun set (WINDOW_INFO { lock, children, ... } )
=
{ lock := bool;
set_list *children;
}
also
fun set_list (wd ! r)
=>
{ set wd;
set_list r;
};
set_list []
=>
();
end;
end;
herein
lock_tree = set_window_subtree_locks_to TRUE;
unlock_tree = set_window_subtree_locks_to FALSE;
end;
# This is called exactly one place, in
# src/lib/x-kit/xclient/pkg/window/xsession.pkg #
fun make_xsocket_to_topwindow_router
{
xdisplay => dy::XDISPLAY { xsocket, ... },
keymap_imp,
to_window_property_imp_slot,
to_selection_imp_slot
}
=
{
xevent_in'
=
xok::wait_for_xevent xsocket;
plea_slot = make_mailslot ();
reply_slot = make_mailslot ();
lock_slot = make_mailslot ();
plea_in' = take' plea_slot;
# hash_xid is from src/lib/x-kit/xclient/pkg/stuff/hash-xid.pkg my window_id_to_window_info_map: hash_xid::Xid_Map( Window_Info )
=
hash_xid::make_map ();
#
get_info = hash_xid::get window_id_to_window_info_map;
set_info = hash_xid::set window_id_to_window_info_map;
drop_info = hash_xid::remove window_id_to_window_info_map;
#
# This is our primary state, mapping
# Window_Id to Window_Info values.
my window_id_to_oneshot_map: hash_xid::Xid_Map( Oneshot_Maildrop(Void) )
=
hash_xid::make_map ();
#
get_oneshot = hash_xid::get window_id_to_oneshot_map;
set_oneshot = hash_xid::set window_id_to_oneshot_map;
drop_oneshot = hash_xid::remove window_id_to_oneshot_map;
#
# There is an unfortunate race condition in which
# NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT
# requests on a window_id may arrive from a client
# thread before we have seen the
# NOTE_NEW_WINDOW
# from the X server which creates the
# window_id_to_window_info_map
# entry for that window_id. We use the above map
# to hold such "prematurely registered" requests
# pending arrival of the corresponding NOTE_NEW_WINDOW.
my gui_startup_complete_oneshot: Oneshot_Maildrop( Void )
=
make_oneshot_maildrop ();
#
# This maildrop exists to give application threads
# something to wait on before presuming that the
# GUI widgettree windows, threads etc are ready for action.
#
# Currently we set this when we first
# get an EXPOSE X event from the X server.
#
seen_first_expose_xevent_of_session
=
REF FALSE;
fun do_plea (plea::NOTE_NEW_TOPWINDOW (window_id, window_site))
=>
{ # Log a new top-level window:
to_topwindow_slot = make_mailslot ();
# Handle any prematurely-registered oneshot.
# I'm not sure a topwindow will ever get an
# EXPOSE event, so this may be pointless:
#
oneshot = { oneshot = get_oneshot window_id;
drop_oneshot window_id;
THE oneshot;
}
except
hash_xid::XID_NOT_FOUND
=
NULL;
set_info
( window_id,
WINDOW_INFO
{
window_id,
to_topwindow_slot,
route => ENVELOPE_ROUTE_END window_id,
parent_info => NULL,
children => REF [],
lock => REF FALSE,
site => REF (xg::site_to_box window_site),
#
seen_first_expose => REF( FALSE ),
seen_first_expose_oneshot => REF( oneshot )
}
);
give (reply_slot, take' to_topwindow_slot);
}
except hash_xid::XID_NOT_FOUND = ();
do_plea (plea::NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT (window_id, oneshot))
=>
{ # Note the oneshot used to signal receipt
# of the first EXPOSE event on a window:
trace .{ sprintf "NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT/TOP: window_id s=%s" (xtype_to_string::xid_to_string window_id); };
{ (get_info window_id)
->
WINDOW_INFO {
seen_first_expose => REF( seen_first_expose ),
seen_first_expose_oneshot,
...
};
trace .{ sprintf "NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT/MID: window_id s=%s, first_expose b=%s" (xtype_to_string::xid_to_string window_id) case seen_first_expose TRUE => "TRUE"; _ => "FALSE"; esac; };
seen_first_expose_oneshot := THE oneshot;
if seen_first_expose
#
set (oneshot, ()); # This shouldn't happen.
fi;
}
except hash_xid::XID_NOT_FOUND
=
{
trace .{ sprintf "NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT/MUD: window_id s=%s: WINDOW_INFO record does not exist yet, parking the oneshot" (xtype_to_string::xid_to_string window_id); };
set_oneshot (window_id, oneshot); # WINDOW_INFO record doesn't exist yet, so park oneshot for now.
};
trace .{ sprintf "NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT/BOT: window_id s=%s" (xtype_to_string::xid_to_string window_id); };
};
do_plea (plea::LOCK_WINDOW window_id) => lock_tree (get_info window_id) except hash_xid::XID_NOT_FOUND = ();
do_plea (plea::UNLOCK_WINDOW window_id) => unlock_tree (get_info window_id) except hash_xid::XID_NOT_FOUND = ();
do_plea (plea::IS_WINDOW_LOCKED window_id)
=>
{ (get_info window_id)
->
WINDOW_INFO { lock, ... };
give (lock_slot, *lock);
}
except
hash_xid::XID_NOT_FOUND
=
{ trace .{ sprintf "ERROR!! IS_WINDOW_LOCKED: window_id %s not yet registered" (xtype_to_string::xid_to_string window_id); };
(); # We probably should be either returning NULL or generating an exception in client thread here. XXX BUGGO FIXME
# XXX BUGGO FIXME I think maybe we should be registering window ids here before putting
# them into circulation, so as to basically eliminate the possibility of this error.
};
do_plea (plea::GET_WINDOW_SITE (window_id, reply_oneshot))
=>
{ (get_info window_id)
->
WINDOW_INFO { site, ... };
set (reply_oneshot, *site);
}
except
hash_xid::XID_NOT_FOUND
=
{ trace .{ sprintf "ERROR!! GET_WINDOW_SITE: window_id %s not yet registered" (xtype_to_string::xid_to_string window_id); };
(); # We probably should be either returning NULL or generating an exception in client thread here. XXX BUGGO FIXME
# XXX BUGGO FIXME I think maybe we should be registering window ids here before putting
# them into circulation, so as to basically eliminate the possibility of this error.
};
do_plea (plea::GET_''SEEN_FIRST_EXPOSE''_ONESHOT (window_id, reply_oneshot))
=>
{ (get_info window_id)
->
WINDOW_INFO { seen_first_expose_oneshot, ... };
set (reply_oneshot, *seen_first_expose_oneshot);
}
except hash_xid::XID_NOT_FOUND
=
{ set (reply_oneshot, THE (get_oneshot window_id))
except
hash_xid::XID_NOT_FOUND
=
{ trace .{ sprintf "ERROR!! GET_''SEEN_FIRST_EXPOSE''_ONESHOT: window_id %s not yet registered" (xtype_to_string::xid_to_string window_id); };
set (reply_oneshot, NULL); # We probably should be generating an exception in client thread here. XXX BUGGO FIXME
# XXX BUGGO FIXME I think maybe we should be registering window ids here before putting
# them into circulation, so as to basically eliminate the possibility of this error.
};
};
do_plea (plea::GET_''GUI_STARTUP_COMPLETE''_ONESHOT reply_oneshot)
=>
set (reply_oneshot, gui_startup_complete_oneshot);
end;
fun note_new_subwindow (parent_window_id, child_window_id, box)
=
{
(get_info parent_window_id)
->
parent_info as WINDOW_INFO { route, to_topwindow_slot, children, lock, ... };
fun extend_route (ENVELOPE_ROUTE_END window_id) => ENVELOPE_ROUTE (window_id, ENVELOPE_ROUTE_END child_window_id);
extend_route (ENVELOPE_ROUTE (window_id, route)) => ENVELOPE_ROUTE (window_id, extend_route route);
end;
child_route = extend_route route;
# Handle any prematurely-registered oneshot:
#
oneshot = { oneshot = get_oneshot child_window_id;
drop_oneshot child_window_id;
trace .{ sprintf "note_new_subwindow: window_id s=%s PICKING UP PREMATURELY REGISTERED ONESHOT" (xtype_to_string::xid_to_string child_window_id); };
THE oneshot;
}
except
hash_xid::XID_NOT_FOUND
=
NULL;
child_info
=
WINDOW_INFO
{
window_id => child_window_id,
route => child_route,
site => REF box,
parent_info => THE parent_info,
children => REF [],
lock => REF *lock,
#
to_topwindow_slot,
#
seen_first_expose => REF( FALSE ),
seen_first_expose_oneshot => REF( oneshot )
};
children := child_info ! *children;
set_info (child_window_id, child_info);
};
fun note_site_change (window_id, box)
=
{ (get_info window_id) -> WINDOW_INFO { site, ... };
site := box;
}
except
hash_xid::XID_NOT_FOUND = ();
fun maybe_note_first_expose_event window_id
=
{
# If this is the first EXPOSE event seen for
# this X session, broadcast that fact for
# anyone waiting:
#
if (not *seen_first_expose_xevent_of_session)
#
seen_first_expose_xevent_of_session := TRUE;
#
set (gui_startup_complete_oneshot, ());
fi;
# If this is the first EXPOSE event for window,
# remember that we've seen it and set the
# condition variable seen_first_expose_oneshot
# to notify any threads waiting for the
# EXPOSE -- see seen_first_redraw_oneshot_of in
# src/lib/x-kit/widget/basic/widget.api #
(get_info window_id)
->
WINDOW_INFO
{ seen_first_expose => seen_first_expose,
seen_first_expose_oneshot => REF seen_first_expose_oneshot,
...
};
trace .{ sprintf "maybe_note_first_expose_event: window_id s=%s, first_expose b=%s" (xtype_to_string::xid_to_string window_id) case seen_first_expose REF TRUE => "TRUE"; _ => "FALSE"; esac; };
case seen_first_expose
#
REF TRUE => (); # Nothing to do.
REF FALSE =>
{
seen_first_expose := TRUE;
trace .{ sprintf "maybe_note_first_expose_event: window_id s=%s, first_expose b=%s FIRST EXPOSE NOTED" (xtype_to_string::xid_to_string window_id) case seen_first_expose REF TRUE => "TRUE"; _ => "FALSE"; esac; };
case seen_first_expose_oneshot
#
THE oneshot => set (oneshot, ()); # Tell all waiting threads this widget is GO for action. :-)
NULL => (); # Oneshot not yet registered -- shouldn't really happen,
esac; # but no big deal, we'll set it when it arrives.
};
esac;
}
except
hash_xid::XID_NOT_FOUND = ();
fun route_xevent_per_window_info (e, WINDOW_INFO { route, to_topwindow_slot, ... } )
=
give (to_topwindow_slot, (route, e));
fun route_xevent_to_window_id (xevent, window_id)
=
route_xevent_per_window_info (xevent, get_info window_id)
except
hash_xid::XID_NOT_FOUND = ();
fun do_xevent xevent
=
case (pick_xevent_action xevent)
#
SEND_TO_WINDOW window_id
=>
route_xevent_to_window_id (xevent, window_id);
NOTE_EXPOSE_AND_SEND_TO_WINDOW window_id
=>
{
maybe_note_first_expose_event window_id;
route_xevent_to_window_id (xevent, window_id);
};
NOTE_SITE_CHANGE_AND_SEND_TO_WINDOW (window_id, box)
=>
{ note_site_change (window_id, box); # Window has changed size and/or position.
route_xevent_to_window_id (xevent, window_id);
};
NOTE_NEW_WINDOW { parent_window_id, created_window_id, box }
=>
{ note_new_subwindow (parent_window_id, created_window_id, box);
#
route_xevent_to_window_id (xevent, parent_window_id);
};
NOTE_WINDOW_DESTRUCTION window_id
=>
case (drop_info window_id)
#
(window_info as WINDOW_INFO { parent_info => THE (WINDOW_INFO { children, ... } ), ... } )
=>
{ fun remove_child ((window_info' as WINDOW_INFO { window_id => window_id', ... } ) ! rest)
=>
if (window_id' == window_id) rest;
else (window_info' ! (remove_child rest));
fi;
remove_child []
=>
{ xgripe::warning "[xsocket-to-topwin: missing child]";
[];
};
end;
children
:=
remove_child *children;
route_xevent_per_window_info (xevent, window_info);
};
window_info
=>
route_xevent_per_window_info (xevent, window_info);
esac;
SEND_TO_KEYMAP_IMP
=>
{ xgripe::warning "[xsocket-to-topwin: unexpected SEND_TO_KEYMAP_IMP]";
();
};
SEND_TO_WINDOW_PROPERTY_IMP => give (to_window_property_imp_slot, xevent);
SEND_TO_SELECTION_IMP => give (to_selection_imp_slot, xevent);
IGNORE => ();
SEND_TO_ALL_WINDOWS
=>
apply (fn (_, window_info) = route_xevent_per_window_info (xevent, window_info))
(hash_xid::list window_id_to_window_info_map);
esac;
mailop = choose [
plea_in' ==> do_plea,
xevent_in' ==> do_xevent
];
# fun loop () = { do_mailop mailop; loop(); };
/* DEBUG */ fun loop () = { trace .{ "xsocket_to_topwindow_router: loop: Top."; };
do_mailop mailop;
loop();
};
xtr::make_thread "xsocket-to-topwin" loop;
XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, reply_slot, lock_slot };
}; # fun make_xsocket_to_topwindow_router
# Add 'topwindow' to window_id_to_window_info_map
# and return the event slot through which we will feed
# X events to that window and its subwindows.
#
# This function is called (only) from make_topwindow_to_widget_router in
#
# src/lib/x-kit/xclient/pkg/window/topwindow-to-widget-router.pkg #
fun note_new_topwindow
( XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, reply_slot, ... },
topwindow_id,
site
)
=
{ give (plea_slot, plea::NOTE_NEW_TOPWINDOW (topwindow_id, site));
#
take reply_slot;
};
# This is nowhere called:
#
fun lock_window_tree (XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, reply_slot, ... }, window_id)
=
{ give (plea_slot, plea::LOCK_WINDOW window_id);
.{ give (plea_slot, plea::UNLOCK_WINDOW window_id); };
};
# This gets called exactly one place, in
#
# src/lib/x-kit/xclient/pkg/window/draw-imp.pkg #
fun window_is_locked (XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, lock_slot, ... }, window_id)
=
{ give (plea_slot, plea::IS_WINDOW_LOCKED window_id);
#
take lock_slot;
};
fun get_window_site (XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, ... }, window_id)
=
{ reply_oneshot = make_oneshot_maildrop ();
give (plea_slot, plea::GET_WINDOW_SITE (window_id, reply_oneshot));
#
get reply_oneshot;
};
# This call is infrastructure.
#
# We often want to wait until a widget is fully
# operational before sending pleas to it.
#
# A practical definition of "operational" is
# "has received its first EXPOSE X event".
#
# We maintain a oneshot in widgets which
# clients may wait on for this purpose; see
# seen_first_redraw_oneshot_of
# in
# src/lib/x-kit/widget/basic/widget.api #
# The oneshot in question originates at widget
# creation time -- make_widget in
#
# src/lib/x-kit/widget/basic/widget.pkg #
# At realization time, which is when a widget
# for the first time becomes associated with an
# X window, it registers its oneshot with us
# via this call: See realize_fn in widget.pkg.
# This ensures that we have the onehost on hand
# when we recieve a window's first EXPOSE event.
#
fun note_window's_''seen_first_expose''_oneshot
(XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, ... }, window_id, oneshot)
=
{
trace .{ sprintf "note_window's_seen_first_expose_oneshot/TOP: window_id s=%s" (xtype_to_string::xid_to_string window_id); };
give (plea_slot, plea::NOTE_''SEEN_FIRST_EXPOSE''_ONESHOT (window_id, oneshot));
trace .{ sprintf "note_window's_seen_first_expose_oneshot/BOT: window_id s=%s" (xtype_to_string::xid_to_string window_id); };
};
fun get_''seen_first_expose''_oneshot_of (XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, ... }, window_id)
=
{ reply_oneshot = make_oneshot_maildrop ();
give (plea_slot, plea::GET_''SEEN_FIRST_EXPOSE''_ONESHOT (window_id, reply_oneshot));
#
get reply_oneshot;
};
fun get_''gui_startup_complete''_oneshot_of (XSOCKET_TO_TOPWINDOW_ROUTER { plea_slot, ... })
=
{ reply_oneshot = make_oneshot_maildrop ();
give (plea_slot, plea::GET_''GUI_STARTUP_COMPLETE''_ONESHOT reply_oneshot);
#
get reply_oneshot;
};
end; # stipulate
}; # package xsocket_to_topwindow_router
end;