## window-watcher-ximp.pkg
#
# The property imp maps PropertyChange X-events
# to those threads that are interested in them
# and manages a collection of unique property names.
#
# This could be done by two separate threads
# but it simplifies things to keep all of the
# property stuff in one place.
# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib### "Truth is much too complicated to
### allow anything but approximations."
###
### -- Johnny von Neumann
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 ap = client_to_atom; # client_to_atom is from src/lib/x-kit/xclient/src/iccc/client-to-atom.pkg# package dy = display; # display is from src/lib/x-kit/xclient/src/wire/display.pkg package ts = xserver_timestamp; # xserver_timestamp is from src/lib/x-kit/xclient/src/wire/xserver-timestamp.pkg package xet = xevent_types; # xevent_types is from src/lib/x-kit/xclient/src/wire/xevent-types.pkg package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkg package wpp = client_to_window_watcher; # client_to_window_watcher is from src/lib/x-kit/xclient/src/window/client-to-window-watcher.pkg package xes = xevent_sink; # xevent_sink is from src/lib/x-kit/xclient/src/wire/xevent-sink.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 window_watcher_ximp
: (weak) Window_Watcher_Ximp # Window_Watcher_Ximp is from src/lib/x-kit/xclient/src/window/window-watcher-ximp.api {
Exports = { # Ports we export for use by other imps.
client_to_window_watcher: wpp::Client_To_Window_Watcher, # Register or look up X atoms.
window_property_xevent_sink: xes::Xevent_Sink # Relevant Xevents from the X server.
};
Imports = { # Ports we use which are exported by other imps.
# xclient_to_sequencer: x2s::Xclient_To_Sequencer, # NOT CURRENTLY USED.
client_to_atom: ap::Client_To_Atom
};
Option = MICROTHREAD_NAME String; #
Window_Watcher_Egg = Void -> (Exports, (Imports, Run_Gun, End_Gun) -> Void);
Watched_Property_Info
=
{ window: xt::Window_Id,
watchers: List( (wpp::Property_Change, ts::Xserver_Timestamp) -> Void ),
is_unique: Bool
};
Window_Watcher_Ximp_State
=
{ prop_table: aht::Hashtable( List( Watched_Property_Info ) ),
unique_props: Ref( List( (xt::Atom, Ref(Bool)) ))
};
Me_Slot = Mailslot( { imports: Imports,
me: Window_Watcher_Ximp_State,
run_gun': Run_Gun,
end_gun': End_Gun
}
);
Xevent_Q = Mailqueue( xet::x::Event );
Runstate = { # These values will be statically globally visible throughout the code body for the imp.
me: Window_Watcher_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 # Requests from x-widgets and such via draw_imp, pen_imp or font_imp.
};
Client_Q = Mailqueue( Runstate -> Void );
fmt_prop_name # Make unique property names.
=
sfprintf::sprintf' "_XKIT_%d";
fun make_prop_name n
=
fmt_prop_name [sfprintf::INT n];
# Operations on the property info tables.
# Each item in the table is a list of
# Watched_Property_Info values, one for each window
# that has a property of the given name.
#
fun make_prop_table () : aht::Hashtable( List( Watched_Property_Info ) )
=
aht::make_hashtable { size_hint => 16, not_found_exception => DIE "PropTable" };
fun find_prop (table, window, name)
=
{ fun get [] => NULL;
#
get ((item: Watched_Property_Info) ! r)
=>
item.window == window
##
?? THE item
:: get r;
end;
case (aht::find table name)
#
THE l => get l;
_ => NULL;
esac;
};
fun insert_watcher (table, window, name, notify_fn, is_unique) # Insert a watcher of a property into the table.
=
case (aht::find table name)
#
NULL => aht::set table (name, [{ window => window, watchers => [notify_fn], is_unique } ]);
#
THE l => aht::set table (name, get l);
esac
where
fun get [] => [ { window, watchers => [notify_fn], is_unique } ];
#
get ((item: Watched_Property_Info) ! r)
=>
if (item.window == window)
#
{ window,
watchers => notify_fn ! item.watchers,
is_unique => item.is_unique
}
!
r;
else
item ! (get r);
fi;
end;
end;
#
fun insert_unique (table: aht::Hashtable( List( Watched_Property_Info ) ), window, name) # Insert a unique property into the table. Since the property is unique,
= # it should not be in the table. NOTE: this will change if we do uniqueness by window.
aht::set table (name, [{ window => window, watchers => [], is_unique => TRUE } ]);
fun remove_prop (table, window, name)
=
{ fun get [] => xgripe::impossible "window_property_imp::remove_prop";
#
get ((item: Watched_Property_Info) ! r)
=>
item.window == window ?? r
:: item ! (get r);
end;
case (get (aht::get table name))
#
[] => { aht::drop table name; };
l => { aht::set table (name, l); };
esac;
};
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: Window_Watcher_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 # Requests from x-widgets and such via draw_imp, pen_imp or font_imp.
}
)
=
loop ()
where
fun loop () # Outer loop for the imp.
=
{ do_one_mailop' to [
#
end_gun' ==> shut_down_window_watcher_ximp',
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_window_watcher_ximp' ()
=
thread_exit { success => TRUE }; # Will not return.
stipulate
fun free_prop name
=
get *me.unique_props
where
fun get [] => xgripe::impossible "window_property_imp::free_prop";
#
get ((atom, avail) ! r)
=>
if (name == atom) avail := TRUE;
else get r;
fi;
end;
end;
fun broadcast ([], msg) => ();
#
broadcast (notify_fn ! rest, msg)
=>
{ notify_fn msg;
#
broadcast (rest, msg);
};
end;
herein
fun do_xevent_plea (xet::x::PROPERTY_NOTIFY { changed_window_id, atom, timestamp, deleted } ) # Handle a window property related X-event
=>
case (find_prop (me.prop_table, changed_window_id, atom), deleted)
#
(THE { watchers, ... }, FALSE)
=>
broadcast (watchers, (wpp::NEW_VALUE, timestamp));
(THE { watchers, is_unique, ... }, TRUE)
=>
{ broadcast (watchers, (wpp::DELETED, timestamp));
#
remove_prop (me.prop_table, changed_window_id, atom);
if is_unique free_prop atom; fi;
};
(NULL, _) => ();
esac;
do_xevent_plea xevent => xgripe::impossible "window_property_imp::make_server::do_xevent";
end;
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_window_watcher = { unused_property,
watch_property
};
window_property_xevent_sink = { put_value
};
to = make_replyqueue();
put_in_oneshot
( reply_oneshot,
( me_slot,
{ client_to_window_watcher,
window_property_xevent_sink
}
) ); # Return value from window_watcher_egg'().
(take_from_mailslot me_slot) # Imports from window_watcher_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
xevent_q = make_mailqueue (get_current_microthread()) : Xevent_Q;
client_q = make_mailqueue (get_current_microthread()) : Client_Q;
fun put_value (xevent: xet::x::Event)
=
put_in_mailqueue (xevent_q, xevent);
fun unused_property window_id
=
{ reply_1shot = make_oneshot_maildrop ();
#
put_in_mailqueue (client_q,
#
\\ ({ me, imports, ... }: Runstate)
=
{ name = get_prop ();
#
insert_unique (me.prop_table, window_id, name);
put_in_oneshot (reply_1shot, name);
}
where
fun get_prop ()
=
get (0, *me.unique_props)
where
fun get (n, [])
=>
{ atom = imports.client_to_atom.make_atom (make_prop_name n);
#
me.unique_props := (atom, REF FALSE) ! *me.unique_props;
atom;
};
get (n, (atom, avail) ! r)
=>
if *avail
#
avail := FALSE;
atom;
else
get (n+1, r);
fi;
end;
end;
end
);
get_from_oneshot reply_1shot;
};
fun watch_property
( name: xt::Atom,
window: xt::Window_Id,
is_unique: Bool,
notify_fn: (wpp::Property_Change, ts::Xserver_Timestamp) -> Void
)
=
put_in_mailqueue (client_q,
#
\\ ({ me, imports, ... }: Runstate)
=
insert_watcher (me.prop_table, window, name, notify_fn, is_unique)
);
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_window_watcher_egg (options: List(Option)) # PUBLIC. PHASE 1: Construct our state and initialize from 'options'.
=
{ (process_options (options, { name => "window_watcher" }))
->
{ name };
me = { prop_table => make_prop_table (), # A table of watched properties
unique_props => REF [] # A list of unique property names
};
\\ () = { 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 property-imp
end;