## selection-ximp.pkg
#
# Support for X selections per ICCC.
#
# Clients can acquire a selection and handle requests
# for it received via the X server, with notification
# of loss of selection ownership.
#
# Clients can also request the contents of a selection
# via the X server.
#
# STILL NEEDS WORK ELIMINATING BLOCKING CALLS IN MAIN LOOP.
#
# See also:
# src/lib/x-kit/xclient/src/window/selection-old.pkg# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib# A per-display imp to handle the ICCCM selection protocol.
#
# NOTES:
# - What about incremental transfers?
# - Currently these operations take a window as an argument, since the
# protocol requires one. The selection imp could allot an unmapped
# window to serve as the source of ids, which would make selections
# independent of specific windows. Let's see how the higher-level interfaces
# work out first.
#
# This mechanism must deal with a complicated protocol, and a bunch of different
# kinds of X events and requests. Here is a summary:
#
# REQUESTS:
# GetSelectionOwner -- used by owner after a SetSelectionOwner to test if the
# selection was acquired.
# SetSelectionOwner -- used by owner to acquire the selection.
# ConvertSelection -- used by requestor to request that the selection value
# be put into some property.
# GetProperty -- used by the requestor to get the selection value.
# ChangeProperty -- used by the owner to put the requested selection in
# the requested property. And used by the requestor to
# delete the property, once it gets the value.
# SendEvent -- used by the owner send a SelectionNotify event to the
# requester.
#
# EVENTS:
# SelectionRequest -- received by the owner as a result of the requestor
# sending a ConvertSelection request.
# SelectionNotify -- sent by the owner to the requestor, once the selection
# has been put into the requested property.
# SelectionClear -- received by the owner, when it loses the selection.
# PropertyNotify -- received by the owner, once the requestor has deleted
# the property.
# This stuff is likely based on Dusty Deboer's
# thesis work: See Chapter 5 (pp46) in:
# http://mythryl.org/pub/exene/dusty-thesis.pdf
stipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package aht = atom_table; # atom_table is from src/lib/x-kit/xclient/src/iccc/atom-table.pkg# package dy = display_old; # xdisplay_old is from src/lib/x-kit/xclient/src/wire/display-old.pkg package e2s = xerror_to_string; # xerror_to_string is from src/lib/x-kit/xclient/src/to-string/xerror-to-string.pkg package xet = xevent_types; # xevent_types is from src/lib/x-kit/xclient/src/wire/xevent-types.pkg package s2w = sendevent_to_wire; # sendevent_to_wire is from src/lib/x-kit/xclient/src/wire/sendevent-to-wire.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.pkg package v2w = value_to_wire; # value_to_wire is from src/lib/x-kit/xclient/src/wire/value-to-wire.pkg package w2v = wire_to_value; # wire_to_value is from src/lib/x-kit/xclient/src/wire/wire-to-value.pkg package sep = client_to_selection; # client_to_selection is from src/lib/x-kit/xclient/src/window/client-to-selection.pkg package xes = xevent_sink; # xevent_sink is from src/lib/x-kit/xclient/src/wire/xevent-sink.pkg package u1v = vector_of_one_byte_unts; # vector_of_one_byte_unts is from src/lib/std/src/vector-of-one-byte-unts.pkg package x2s = xclient_to_sequencer; # xclient_to_sequencer is from src/lib/x-kit/xclient/src/wire/xclient-to-sequencer.pkgherein
# This imp is typically instantiated by:
#
# src/lib/x-kit/xclient/src/window/xsession-junk.pkg package selection_ximp
: (weak) Selection_Ximp # Selection_Ximp is from src/lib/x-kit/xclient/src/window/selection-ximp.api {
Exports = { # Ports we export for use by other imps.
client_to_selection: sep::Client_To_Selection, # Requests from widget/application code.
selection_xevent_sink: xes::Xevent_Sink
};
Imports = { # Ports we use which are exported by other imps.
xclient_to_sequencer: x2s::Xclient_To_Sequencer
};
Option = MICROTHREAD_NAME String; #
Selection_Egg = Void -> (Exports, (Imports, Run_Gun, End_Gun) -> Void);
Selection_Plea = sep::Selection_Plea; # The request for a selection that gets sent to the owner.
Selection_Data # Data about held selections.
=
{ owner: xt::Window_Id,
do_plea: Selection_Plea -> Void,
release_1shot: Oneshot_Maildrop( Void ),
timestamp: ts::Xserver_Timestamp
};
Request_Data = Oneshot_Maildrop( Null_Or( xt::Property_Value ) ); # Data about outstanding selection requests.
Selection_Ximp_State # Holds all mutable state maintained by ximp.
=
{ selection_table: aht::Hashtable( Selection_Data ),
plea_table: aht::Hashtable( Request_Data )
};
Me_Slot = Mailslot( { imports: Imports,
me: Selection_Ximp_State,
run_gun': Run_Gun,
end_gun': End_Gun
}
);
Request_Result = Mailop( Null_Or( xt::Property_Value ) ); # The return result of a PLEA_REQUEST_SELECTION.
# Client_Plea
# #
# = PLEA_ACQUIRE_SELECTION # Acquire a selection.
# {
# window: xt::Window_Id,
# selection: xt::Atom,
# timestamp: ts::Xserver_Timestamp,
# do_plea: sep::Selection_Plea -> Void,
# ack: Oneshot_Maildrop( Null_Or( sep::Selection_Handle ) )
# }
#
# | PLEA_RELEASE_SELECTION xt::Atom # Release a selection.
#
# | PLEA_REQUEST_SELECTION # Request the value of a selection.
# {
# window: xt::Window_Id,
# selection: xt::Atom,
# target: xt::Atom,
# property: xt::Atom,
# timestamp: ts::Xserver_Timestamp,
# ack: Oneshot_Maildrop( Request_Result )
# }
# ;
Xevent_Q = Mailqueue( xet::x::Event );
Runstate = { # These values will be statically globally visible throughout the code body for the imp.
me: Selection_Ximp_State, #
imports: Imports, # Ximps to which we send requests.
to: Replyqueue, # The name makes foo::pass_something(imp) to {. ... } syntax read well.
end_gun': End_Gun, # We shut down the microthread when this fires.
xevent_q: Xevent_Q #
};
Client_Q = Mailqueue( Runstate -> Void );
# +DEBUG
fun log_if f = xlogger::log_if xlogger::selection_logging 0 f;
# -DEBUG
# Given message encode and
# reply decode functions,
# send and receive a query:
#
fun query (encode, decode) (xclient_to_sequencer: x2s::Xclient_To_Sequencer)
=
ask
where
send_xrequest_and_read_reply
=
xclient_to_sequencer.send_xrequest_and_read_reply;
fun ask msg
=
(decode (block_until_mailop_fires (send_xrequest_and_read_reply (encode msg))));
# ========================
end;
get_selection_owner # Various protocol requests that we need.
=
query
( v2w::encode_get_selection_owner,
w2v::decode_get_selection_owner_reply
);
fun set_selection_owner (xclient_to_sequencer: x2s::Xclient_To_Sequencer) arg
=
xclient_to_sequencer.send_xrequest (v2w::encode_set_selection_owner arg);
fun convert_selection (xclient_to_sequencer: x2s::Xclient_To_Sequencer) arg
=
xclient_to_sequencer.send_xrequest (v2w::encode_convert_selection arg);
fun selection_notify (xclient_to_sequencer: x2s::Xclient_To_Sequencer) { requesting_window_id, selection, target, property, timestamp }
=
xclient_to_sequencer.send_xrequest
(s2w::encode_send_selectionnotify_xevent
{
requesting_window_id,
selection,
target,
timestamp,
property,
send_event_to => xt::SEND_EVENT_TO_WINDOW requesting_window_id,
propagate => FALSE,
event_mask => xt::EVENT_MASK 0u0
}
);
req_get_property
=
query
( v2w::encode_get_property,
w2v::decode_get_property_reply
);
fun change_property (xclient_to_sequencer: x2s::Xclient_To_Sequencer) arg
=
xclient_to_sequencer.send_xrequest (v2w::encode_change_property arg);
#
fun get_property xclient_to_sequencer (window_id, property) # Get a property value, which may require several requests.
=
get_property' ()
where
fun size_of (xt::RAW_DATA { data, ... } )
=
(u1v::length data / 4);
fun get_bytes words_so_far
=
req_get_property xclient_to_sequencer
{
window_id,
property,
type => NULL, # AnyPropertyType.
offset => words_so_far,
len => 1024,
delete => FALSE
};
fun delete_property ()
=
req_get_property xclient_to_sequencer
{
window_id,
property,
type => NULL, # AnyPropertyType.
offset => 0,
len => 0,
delete => TRUE
};
fun extend_data (data', xt::RAW_DATA { data, ... } )
=
data ! data';
fun flatten_data (data', xt::RAW_DATA { format, data } )
=
xt::RAW_DATA { format,
data => u1v::cat (reverse (data ! data'))
};
fun get_property' ()
=
case (get_bytes 0)
#
NULL => NULL;
THE { type, bytes_after, value as xt::RAW_DATA { data, ... } }
=>
if (bytes_after == 0)
#
delete_property();
THE (xt::PROPERTY_VALUE { type, value } );
else
get_remaining_bytes (size_of value, [data]);
fi;
esac
also
fun get_remaining_bytes (words_so_far, data')
=
case (get_bytes words_so_far)
#
NULL => NULL;
THE { type, bytes_after, value }
=>
if (bytes_after == 0)
#
delete_property();
THE (xt::PROPERTY_VALUE { type, value=>flatten_data (data', value) } );
else
get_remaining_bytes (
words_so_far + size_of value,
extend_data (data', value)
);
fi;
esac;
end;
fun run ( client_q: Client_Q, # Requests from x-widgets and such via draw_imp, pen_imp or font_imp.
#
runstate as
{ # These values will be statically globally visible throughout the code body for the imp.
me: Selection_Ximp_State, #
imports: Imports, # Ximps to which we send requests.
to: Replyqueue, # The name makes foo::pass_something(imp) to {. ... } syntax read well.
end_gun': End_Gun, # We shut down the microthread when this fires.
xevent_q: Xevent_Q #
}
)
=
loop ()
where
# insert_selection = aht::set me.selection_table;
find_selection = aht::find me.selection_table;
drop_selection = aht::drop me.selection_table;
#
# insert_plea = aht::set me.plea_table;
find_plea = aht::find me.plea_table;
drop_plea = aht::drop me.plea_table;
fun loop () # Outer loop for the imp.
=
{ do_one_mailop' to [
#
end_gun' ==> shut_down_selection_imp',
take_from_mailqueue' client_q ==> do_client_plea,
take_from_mailqueue' xevent_q ==> do_xevent_plea
];
loop ();
}
where
fun do_client_plea thunk
=
thunk runstate;
fun shut_down_selection_imp' ()
=
thread_exit { success => TRUE }; # Will not return.
# fun do_client_plea (PLEA_ACQUIRE_SELECTION { window, selection, timestamp, do_plea, ack } ) # Handle a request.
# =>
# { log_if {. "PLEA_AcquireSel"; };
# #
# set_selection_owner imports.xclient_to_sequencer
# {
# selection,
# window_id => THE window,
# timestamp => xt::TIMESTAMP timestamp
# };
#
# log_if {. "PLEA_AcquireSel: check owner"; };
#
# case (get_selection_owner imports.xclient_to_sequencer { selection } ) # THIS IS A BLOCKING CALL
# # # XXX SUCKO FIXME
# NULL => put_in_oneshot (ack, NULL);
#
# THE id => if (id != window)
# #
# put_in_oneshot (ack, NULL);
# else
# release_1shot = make_oneshot_maildrop ();
#
# result = { selection,
# timestamp,
# release' => get_from_oneshot' release_1shot,
# release => {. put_in_mailqueue (client_q, PLEA_RELEASE_SELECTION selection); }
# };
#
# insert_selection (selection, { owner=>window, do_plea, release_1shot, timestamp } );
#
# put_in_oneshot (ack, THE result);
# fi;
# esac;
# };
#
# do_client_plea (PLEA_RELEASE_SELECTION selection) # Client holding selection has decided to release it.
# =>
# {
# log_if {. "PLEA_ReleaseSel"; };
#
# drop_selection selection;
#
# set_selection_owner imports.xclient_to_sequencer
# {
# selection,
# window_id => NULL,
# timestamp => xt::CURRENT_TIME # ???
# };
#
## xok::flush_xsocket xsocket;
# };
#
# do_client_plea (PLEA_REQUEST_SELECTION req)
# =>
# {
# reply_1shot = make_oneshot_maildrop ();
#
# log_if {. "PLEA_RequestSel"; };
#
# insert_plea (req.selection, reply_1shot);
#
# convert_selection imports.xclient_to_sequencer
# {
# selection => req.selection,
# target => req.target,
# property => THE req.property,
# requestor => req.window,
# timestamp => xt::TIMESTAMP req.timestamp
# };
#
# put_in_oneshot (req.ack, get_from_oneshot' reply_1shot);
# };
# end;
fun do_xevent_plea (xet::x::SELECTION_REQUEST xevent) # Handle a selection related X-event.
=>
{ fun reject_request ()
=
selection_notify imports.xclient_to_sequencer
{
requesting_window_id => xevent.requesting_window_id,
selection => xevent.selection,
target => xevent.target,
#
property => NULL,
timestamp => xevent.timestamp
};
log_if {. "SelectionRequestXEvt"; };
case (find_selection xevent.selection, xevent.timestamp)
#
(NULL, _) => { # We don't hold this selection, return NULL.
log_if {. " SelectionRequestXEvt rejected: no selection"; };
reject_request ();
};
(THE selection, timestamp)
=>
{
make_thread "selection imp reply" {.
#
null_or_timestamp
=
case timestamp
#
xt::CURRENT_TIME => NULL;
xt::TIMESTAMP timestamp => THE timestamp;
esac;
# Propagate the request to
# the holder of the selection:
prop = case xevent.property THE prop => prop;
NULL => xevent.target; # obsolete client
esac;
reply_1shot = make_oneshot_maildrop ();
selection.do_plea { target => xevent.target,
timestamp => null_or_timestamp,
reply => (\\ x = put_in_oneshot (reply_1shot, x))
};
case (get_from_oneshot reply_1shot)
#
NULL => reject_request ();
THE prop_val # Write out the property value.
=>
{ change_property imports.xclient_to_sequencer
{
window_id => xevent.requesting_window_id,
name => prop,
mode => xt::REPLACE_PROPERTY,
property => prop_val
};
selection_notify imports.xclient_to_sequencer
{
requesting_window_id => xevent.requesting_window_id,
selection => xevent.selection,
target => xevent.target,
property => xevent.property,
timestamp
};
};
esac;
}; # make_thread.
();
};
esac;
}; # handleEvt SelectionRequestXEvt
do_xevent_plea (xet::x::SELECTION_CLEAR { selection, ... } )
=>
{ log_if {. "SelectionClearXEvt"; };
#
case (find_selection selection)
#
NULL => (); # error ???
THE { release_1shot, ... }
=>
{ drop_selection selection;
#
put_in_oneshot (release_1shot, ());
};
esac;
};
do_xevent_plea (xet::x::SELECTION_NOTIFY xevent)
=>
{ log_if {. "SelectionNotifyXEvt"; };
#
case (find_plea xevent.selection, xevent.property)
#
(NULL, _) => (); # error ??
(THE reply_1shot, NULL)
=>
{ drop_plea xevent.selection;
#
put_in_oneshot (reply_1shot, NULL);
};
(THE reply_1shot, THE property)
=>
{ property_value = get_property imports.xclient_to_sequencer (xevent.requesting_window_id, property); # XXX SUCKO FIXME this is a blocking call.
#
drop_plea xevent.selection;
put_in_oneshot (reply_1shot, property_value);
};
esac;
};
do_xevent_plea xevent
=>
xgripe::impossible "selection_imp::make_server::do_xevent_plea";
end;
end; # fun loop
end; # fun run
fun startup (reply_oneshot: Oneshot_Maildrop( (Me_Slot, Exports) )) () # Root fn of imp microthread. Note currying.
=
{ me_slot = make_mailslot () : Me_Slot;
#
client_to_selection = {
acquire_selection,
request_selection
};
selection_xevent_sink = { put_value
};
to = make_replyqueue();
put_in_oneshot (reply_oneshot, (me_slot, { client_to_selection, selection_xevent_sink })); # Return value from xsequencer_egg'().
(take_from_mailslot me_slot) # Imports from xsequencer_egg'().
->
{ me, imports, run_gun', end_gun' };
block_until_mailop_fires run_gun'; # Wait for the starting gun.
run (client_q, { me, xevent_q, imports, to, end_gun' }); # Will not return.
}
where
client_q = make_mailqueue (get_current_microthread()) : Client_Q;
xevent_q = make_mailqueue (get_current_microthread()) : Xevent_Q;
# insert_selection = aht::set me.selection_table;
# find_selection = aht::find me.selection_table;
# drop_selection = aht::drop me.selection_table;
#
# insert_plea = aht::set me.plea_table;
# find_plea = aht::find me.plea_table;
# drop_plea = aht::drop me.plea_table;
fun put_value (xevent: xet::x::Event)
=
put_in_mailqueue (xevent_q, xevent);
#
fun acquire_selection
( window: xt::Window_Id,
selection: xt::Atom,
timestamp: ts::Xserver_Timestamp,
do_plea: sep::Selection_Plea -> Void
)
=
{ reply_1shot = make_oneshot_maildrop ();
#
put_in_mailqueue ( client_q,
#
\\ ({ me, imports, ... }: Runstate)
=
{ log_if {. "PLEA_AcquireSel"; };
#
set_selection_owner imports.xclient_to_sequencer
{
selection,
window_id => THE window,
timestamp => xt::TIMESTAMP timestamp
};
log_if {. "PLEA_AcquireSel: check owner"; };
case (get_selection_owner imports.xclient_to_sequencer { selection } ) # THIS IS A BLOCKING CALL
# # XXX SUCKO FIXME
NULL => put_in_oneshot (reply_1shot, NULL);
THE id => if (id != window)
#
put_in_oneshot (reply_1shot, NULL);
else
release_1shot = make_oneshot_maildrop ();
result = { selection,
timestamp,
release' => get_from_oneshot' release_1shot,
release => {. put_in_mailqueue (client_q,
#
\\ ({ me, imports, ... }: Runstate)
=
{
log_if {. "PLEA_ReleaseSel"; };
aht::find me.selection_table selection;
set_selection_owner imports.xclient_to_sequencer
{
selection,
window_id => NULL,
timestamp => xt::CURRENT_TIME # ???
};
# xok::flush_xsocket xsocket;
}
# PLEA_RELEASE_SELECTION selection
);
}
};
aht::set me.selection_table (selection, { owner=>window, do_plea, release_1shot, timestamp } );
put_in_oneshot (reply_1shot, THE result);
fi;
esac;
}
# PLEA_ACQUIRE_SELECTION { window, selection, timestamp, do_plea, ack => reply_1shot }
);
get_from_oneshot reply_1shot;
};
#
fun request_selection
{ window: xt::Window_Id, # Requesting window.
selection: xt::Atom, # Requested selection.
target: xt::Atom, # Requested target type.
property: xt::Atom,
timestamp: ts::Xserver_Timestamp # Server-timestamp of the gesture causing the request.
}
=
{ reply_1shot = make_oneshot_maildrop ();
#
put_in_mailqueue
( client_q,
#
\\ ({ me, imports, ... }: Runstate)
=
{
reply_1shot' = make_oneshot_maildrop ();
log_if {. "PLEA_RequestSel"; };
aht::set me.plea_table (selection, reply_1shot');
convert_selection imports.xclient_to_sequencer
{
selection => selection,
target => target,
property => THE property,
requestor => window,
timestamp => xt::TIMESTAMP timestamp
};
put_in_oneshot (reply_1shot, get_from_oneshot' reply_1shot');
}
#
# PLEA_REQUEST_SELECTION
# { window,
# selection,
# target,
# property,
# timestamp,
# ack => reply_1shot
# }
);
get_from_oneshot reply_1shot;
};
end;
fun process_options (options: List(Option), { name })
=
{ my_name = REF name;
#
apply do_option options
where
fun do_option (MICROTHREAD_NAME n) = my_name := n;
end;
{ name => *my_name };
};
##########################################################################################
# PUBLIC.
#
fun make_selection_egg (options: List(Option)) # PUBLIC. PHASE 1: Construct our state and initialize from 'options'.
=
{ (process_options (options, { name => "selection" }))
->
{ name };
me = { selection_table => aht::make_hashtable { size_hint => 32, not_found_exception => DIE "SelectionTable" },
plea_table => aht::make_hashtable { size_hint => 32, not_found_exception => DIE "RequestTable" }
};
\\ () = { reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( (Me_Slot, Exports) ); # PUBLIC. PHASE 2: Start our microthread and return our Exports to caller.
#
xlogger::make_thread name (startup reply_oneshot); # Note that startup() is curried.
(get_from_oneshot reply_oneshot) -> (me_slot, exports);
fun phase3 # PUBLIC. PHASE 3: Accept our Imports, then wait for Run_Gun to fire.
(
imports: Imports,
run_gun': Run_Gun,
end_gun': End_Gun
)
=
{
put_in_mailslot (me_slot, { me, imports, run_gun', end_gun' });
};
(exports, phase3);
};
};
}; # package selection_ximp
end;