## widget-cable-old.pkg
#
# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib# A widget cable is a collection of
# three input streams and one output stream
# used by a widget to communicate with its parent.
#
# The three input streams are:
# mouse mail
# keyboard mail
# other (e.g. expose events)
#
# The output stream is:
# mail to parent.
stipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package s2t = xsocket_to_hostwindow_router_old; # xsocket_to_hostwindow_router_old is from src/lib/x-kit/xclient/src/window/xsocket-to-hostwindow-router-old.pkg package dt = draw_types_old; # draw_types_old is from src/lib/x-kit/xclient/src/window/draw-types-old.pkg package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package hw = hash_window_old; # hash_window_old is from src/lib/x-kit/xclient/src/window/hash-window-old.pkg package kb = keys_and_buttons; # keys_and_buttons is from src/lib/x-kit/xclient/src/wire/keys-and-buttons.pkg package ks = keysym; # keysym is from src/lib/x-kit/xclient/src/window/keysym.pkg package ts = xserver_timestamp; # xserver_timestamp is from src/lib/x-kit/xclient/src/wire/xserver-timestamp.pkg package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkgherein
# This package gets 'include'ed in
#
# src/lib/x-kit/xclient/xclient.pkg #
package widget_cable_old {
#
stipulate
Motion_Transition
=
{ window_point: g2d::Point, # Mouse position in window coords.
screen_point: g2d::Point, # Mouse position in screen coords. XXX BUGGO FIXME shouldn't window and screen points be different types?
timestamp: ts::Xserver_Timestamp
};
Button_Up_Down
=
{ mouse_button: xt::Mousebutton, # Button that is in transition.
window_point: g2d::Point, # Mouse position in window coords.
screen_point: g2d::Point, # Mouse position in screen coords.
# # NOTE: We may also want the modifier-key state.
timestamp: ts::Xserver_Timestamp
};
Button_Transition
=
{ mouse_button: xt::Mousebutton, # Button that is in transition.
window_point: g2d::Point, # Mouse position in window coords.
screen_point: g2d::Point, # Mouse position in screen coords.
state: xt::Mousebuttons_State, # List of buttons that are pressed.
# # NOTE: We may also want the modifier-key state.
timestamp: ts::Xserver_Timestamp
};
herein
# These envelope-routed messages notify a
# target window of mouse events. An
# extended discussion may be found
# at the bottom of src/lib/x-kit/widget/old/basic/widget.pkg #
# MOUSE_MOTION
# Notification of change in mouse position,
# given in both window and screen coordinates.
#
# MOUSE_DOWN
# MOUSE_UP
# MOUSE_FIRST_DOWN
# MOUSE_LAST_UP
# Notification of mouse button transitions.
# including time, position, button changed,
# and resulting state of all buttons.
#
# MOUSE_ENTER
# MOUSE_LEAVE
# Notification of mouse entering/leaving window.
#
# MOUSE_CONFIG_SYNC
# Generated by parent window for barrier
# synchronization, together with a matching
# KEY_CONFIG_SYNC on the mouse stream.
#
Mouse_Mail
= MOUSE_FIRST_DOWN Button_Up_Down
| MOUSE_LAST_UP Button_Up_Down
#
| MOUSE_DOWN Button_Transition
| MOUSE_UP Button_Transition
#
| MOUSE_MOTION Motion_Transition
| MOUSE_ENTER Motion_Transition
| MOUSE_LEAVE Motion_Transition
#
| MOUSE_CONFIG_SYNC
;
end;
# These envelope-routed messages notify a
# window of keyboard events that occur while
# the keyboard focus was in that window. An
# extended discussion may be found
# at the bottom of src/lib/x-kit/widget/old/basic/widget.pkg #
# KEY_PRESS
# KEY_RELEASE
# User press/release of a keyboard key.
# The keysym gives the actual key;
# the second argument gives the state
# of control/shift/etc modifier keys.
#
# KEY_CONFIG_SYNC
# A parent window synchronizing state on
# all three channels generates this at
# the same time as MOUSE_CONFIG_SYNC on
# the mouse stream.
#
Keyboard_Mail
= KEY_PRESS (ks::Keysym, xt::Modifier_Keys_State)
| KEY_RELEASE (ks::Keysym, xt::Modifier_Keys_State)
| KEY_CONFIG_SYNC
;
# Envelopes from our parent window,
# corresponding to X events. An
# extended discussion may be found
# at the bottom of src/lib/x-kit/widget/old/basic/widget.pkg #
# ETC_REDRAW
# X Expose event: Need to redraw indicated parts
# or else all of widget. Wee
# which we need to redraw to restore the display.
#
# ETC_RESIZE
# Notification of a change in the size of our window.
#
# ETC_CHILD_BIRTH
# ETC_CHILD_DEATH
# Notification of status change in our childlist.
# The system guarantees that ETC_CHILD_BIRTH will
# be seen before any other control messages for
# that window, and that there will be no control
# messages for a child after ETC_CHILD_DEATH. Also,
# corresponding synchronization messages are passed
# down the mouse and keyboard streams to allow a
# barrier style synchronization on configuration
# changes. These messages are used in the widget
# envelope routers to automatically reconfigure message
# routine in compound widgets.
#
# ETC_OWN_DEATH
# Our X server window no longer exists.
#
Other_Mail
= ETC_REDRAW List( g2d::Box )
| ETC_RESIZE g2d::Box
#
| ETC_CHILD_BIRTH dt::Window
| ETC_CHILD_DEATH dt::Window
| ETC_OWN_DEATH
;
# Messages from child to parent are not in envelopes,
# since they only go one hop and consequently don't
# need the extended routing provided by envelopes.
#
# Note that incautious bidirectional parent<->child
# control communication can easily lead to deadlock!
#
Mail_To_Mom
= REQ_RESIZE
| REQ_DESTRUCTION
;
# An addressed message (with sequence number)
#
Envelope(X)
=
ENVELOPE
{ route: s2t::Envelope_Route,
seqn: Int,
contents: X
};
# NB: Envelope_Route is defined in src/lib/x-kit/xclient/src/window/xsocket-to-hostwindow-router-old.pkg # Probably both it and Envelope() should be defined in an envelope.pkg. XXX BUGGO FIXME.
Kidplug
=
KIDPLUG
{ from_mouse': Mailop( Envelope( Mouse_Mail ) ),
from_keyboard': Mailop( Envelope( Keyboard_Mail ) ),
from_other': Mailop( Envelope( Other_Mail ) ),
#
to_mom: Mail_To_Mom -> Mailop( Void )
};
# NB: 'sink' here should be understood
Momplug # in the electrical engineering sense
= # of current 'sources' and 'sinks'.
MOMPLUG
{ mouse_sink: Envelope( Mouse_Mail ) -> Mailop( Void ),
keyboard_sink: Envelope( Keyboard_Mail ) -> Mailop( Void ),
other_sink: Envelope( Other_Mail ) -> Mailop( Void ),
#
from_kid': Mailop( Mail_To_Mom )
};
# Void -> (Kid_End, Mom_End)
#
fun make_widget_cable ()
=
{ from_mouse_slot = make_mailslot ();
from_keyboard_slot = make_mailslot ();
from_mom_slot = make_mailslot ();
to_mom_slot = make_mailslot ();
fun out_event slot x
=
put_in_mailslot' (slot, x);
{ kidplug
=>
KIDPLUG
{ from_mouse' => take_from_mailslot' from_mouse_slot,
from_keyboard' => take_from_mailslot' from_keyboard_slot,
from_other' => take_from_mailslot' from_mom_slot,
#
to_mom => out_event to_mom_slot
},
momplug
=>
MOMPLUG
{ mouse_sink => out_event from_mouse_slot,
keyboard_sink => out_event from_keyboard_slot,
other_sink => out_event from_mom_slot,
#
from_kid' => take_from_mailslot' to_mom_slot
}
};
};
# Hop-by-hop envelope routing:
#
Pass_To(X)
= TO_SELF(X) # Envelope has reached its target window/widget.
| TO_CHILD Envelope(X) # Envelope needs to be passed on down the widget hierarchy.
;
# Figure out next step in delivering
# an envelope -- either it is for us,
# or else it needs to be passed to
# one of our kids:
#
fun route_envelope (ENVELOPE { route=>s2t::ENVELOPE_ROUTE_END _, contents, ... } )
=>
TO_SELF contents;
route_envelope (ENVELOPE { route=>s2t::ENVELOPE_ROUTE(_, rest_of_route), seqn, contents } )
=>
TO_CHILD (ENVELOPE { route=>rest_of_route, seqn, contents } );
end;
stipulate
fun next_window (ENVELOPE { route=>s2t::ENVELOPE_ROUTE_END dst, ... } ) => dst;
next_window (ENVELOPE { route=>s2t::ENVELOPE_ROUTE (w, _), ... } ) => w;
end;
herein
# Compare envelope to window and return
# TRUE iff envelope should be routed to
# that window for delivery:
#
fun to_window (envelope, { window_id, ... }: dt::Window )
=
(next_window envelope) == window_id;
exception NO_MATCH_WINDOW;
# Search a list of child windows
# and return the one matching the
# given envelope's delivery route.
#
# Raise NO_MATCH_WINDOW if there
# is no match. (Shouldn't happen.)
#
# This function does a linear sequential
# search which is usually fast enough;
# if a window has too many children for
# this to be sensible, use instead
#
# next_stop_for_envelope_via_hashtable
#
fun next_stop_for_envelope windows envelope
=
find windows
where
w = next_window envelope;
fun find (({ window_id, ... }: dt::Window, x) ! r)
=>
if (window_id == w) x;
else find r;
fi;
find []
=>
raise exception NO_MATCH_WINDOW;
end;
end;
# Faster version of above, used in
#
# src/lib/x-kit/widget/old/basic/xevent-mail-router.pkg #
fun next_stop_for_envelope_via_hashtable map
=
{ get = hw::get_window_id map;
\\ envelope = get (next_window envelope);
};
# Compare envelopes by sequence number.
#
# Since keyboard- and mouse-event envelopes
# get routed down separate streams, it is
# possible for them to be delivered out of
# order. Most widgets do not care, but those
# which do can use this function to recover
# the original ordering.
#
fun envelope_before
( ENVELOPE { seqn=>a, ... },
ENVELOPE { seqn=>b, ... }
)
=
(a < b);
fun get_contents_of_envelope (ENVELOPE { contents, ... } )
=
contents;
end; # stipulate fun next_window ...
# Replace the given input stream with another:
#
fun replace_mouse (KIDPLUG { from_keyboard', from_other', to_mom, ... }, from_mouse' ) = KIDPLUG { from_mouse', from_keyboard', from_other', to_mom };
fun replace_keyboard (KIDPLUG { from_mouse', from_other', to_mom, ... }, from_keyboard') = KIDPLUG { from_mouse', from_keyboard', from_other', to_mom };
fun replace_other (KIDPLUG { from_mouse', from_keyboard', to_mom, ... }, from_other' ) = KIDPLUG { from_mouse', from_keyboard', from_other', to_mom };
exception MAILOP_ON_IGNORED_STREAM;
# Create new kidplug that ignores the given stream.
# Using (i.e. doing a mailop on) an ignored stream
# will raise an exception, but ignoring a stream twice
# will work.
#
stipulate
fun ignore mailop
=
{
ignore_mailop
=
always' ()
==>
{. raise exception MAILOP_ON_IGNORED_STREAM; };
fun loop ()
=
for (;;) {
block_until_mailop_fires mailop;
};
make_thread "widget_cable" {.
loop ()
except
_ = ();
};
ignore_mailop;
};
herein
fun ignore_mouse (KIDPLUG { from_mouse', from_keyboard', from_other', to_mom } ) = KIDPLUG { from_mouse'=>ignore from_mouse', from_keyboard', from_other', to_mom };
fun ignore_keyboard (KIDPLUG { from_mouse', from_keyboard', from_other', to_mom } ) = KIDPLUG { from_mouse', from_keyboard'=>ignore from_keyboard', from_other', to_mom };
fun ignore_mouse_and_keyboard (KIDPLUG { from_mouse', from_keyboard', from_other', to_mom } ) = KIDPLUG { from_mouse'=>ignore from_mouse', from_keyboard'=>ignore from_keyboard', from_other', to_mom };
fun ignore_all (KIDPLUG { from_mouse', from_keyboard', from_other', to_mom } ) = KIDPLUG { from_mouse'=>ignore from_mouse', from_keyboard'=>ignore from_keyboard', from_other'=>ignore from_other', to_mom };
end;
# An input stream that never produces messages
#
my null_stream: Mailop( Envelope(X) )
=
threadkit::never';
# Eat mouse mail while the given
# mouse-button state predicate is satisfied.
#
# Note that the mouse stream may need
# to be wrapped by "get_contents_of_envelope"
#
fun while_mouse_state
predicate
(init_state, m)
=
loop init_state
where
fun loop state
=
if (predicate state)
#
case (block_until_mailop_fires m)
#
MOUSE_FIRST_DOWN { mouse_button, ... } => loop (kb::make_mousebutton_state [mouse_button]);
MOUSE_LAST_UP _ => loop (xt::MOUSEBUTTON_STATE 0u0);
MOUSE_DOWN { state, ... } => loop state;
MOUSE_UP { state, ... } => loop state;
_ => loop state;
esac;
fi;
end;
}; # package widget_cable
end; # stipulate