## window-property-imp.pkg
# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib# 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.
### "Truth is much too complicated to
### allow anything but approximations."
###
### -- Johnny von Neumann
stipulate
include 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/pkg/iccc/atom-table.pkg package ai = atom_imp; # atom_imp is from src/lib/x-kit/xclient/pkg/iccc/atom-imp.pkg package dy = display; # display is from src/lib/x-kit/xclient/pkg/wire/display.pkg package ts = xserver_timestamp; # xserver_timestamp is from src/lib/x-kit/xclient/pkg/wire/xserver-timestamp.pkg package xe = event_types; # event_types is from src/lib/x-kit/xclient/pkg/wire/event-types.pkg package xok = xsocket; # xsocket is from src/lib/x-kit/xclient/pkg/wire/xsocket.pkg package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/pkg/wire/xtypes.pkgherein
package window_property_imp
: (weak) Window_Property_Imp # Window_Property_Imp is from src/lib/x-kit/xclient/pkg/window/window-property-imp.api {
Atom = xt::Atom;
# Make unique property names:
#
fmt_prop_name
=
sfprintf::sprintf' "_XKIT_%d";
fun make_prop_name n
=
fmt_prop_name [sfprintf::INT n];
# Observed changes to property values:
#
Property_Change
=
NEW_VALUE | DELETED;
# Property imp requests:
#
Plea_Mail
=
WATCH_PROP {
name: Atom, # Watched property's name.
window: xt::Window_Id, # Watched property's window.
is_unique: Bool, # TRUE, if the property is an internally
# allocated uniquely named property.
notify_slot # Slot which gets the change notifications.
:
Mailslot( (Property_Change, ts::Xserver_Timestamp) )
}
| ALLOC_PROP (xt::Window_Id, Oneshot_Maildrop( Atom ))
;
# Representation of the
# selection imp connection:
#
Window_Property_Imp
=
WINDOW_PROPERTY_IMP {
xsocket: xok::Xsocket,
plea_slot: Mailslot( Plea_Mail )
};
# Watched property info:
#
Property_Info
=
{ window: xt::Window_Id,
watchers: List( Mailslot( (Property_Change, ts::Xserver_Timestamp) ) ),
is_unique: Bool
};
# Operations on the property info tables.
# Each item in the table is a list of
# Property_Info values, one for each window
# that has a property of the given name.
#
fun make_prop_table () : aht::Hashtable( List( Property_Info ) )
=
aht::make_hashtable { size_hint => 16, not_found_exception => FAIL "PropTable" };
fun find_prop (table, window, name)
=
{ fun get []
=>
NULL;
get ((item: Property_Info) ! r)
=>
item.window == window
##
?? THE item
:: get r;
end;
case (aht::find table name)
#
THE l => get l;
_ => NULL;
esac;
};
# Insert a watcher of a property into the table.
#
fun insert_watcher (table, window, name, watcher, is_unique)
=
{ fun get []
=>
[ { window => window, watchers => [watcher], is_unique } ];
get ((item: Property_Info) ! r)
=>
if (item.window == window)
#
{ window,
watchers => watcher ! item.watchers,
is_unique => item.is_unique
}
!
r;
else
item ! (get r);
fi;
end;
case (aht::find table name)
NULL
=>
aht::set
table
(name, [{ window => window, watchers => [watcher], is_unique } ]);
THE l => aht::set table (name, get l);
esac;
};
# 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.
#
fun insert_unique (table: aht::Hashtable( List( Property_Info ) ), window, name)
=
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: Property_Info) ! r)
=>
item.window == window ?? r
:: item ! (get r);
end;
case (get (aht::get table name))
#
[] => { aht::remove table name; (); };
l => { aht::set table (name, l); };
esac;
};
fun make_window_property_imp (xdpy as dy::XDISPLAY { xsocket, ... }, atom_imp)
=
{ prop_table = make_prop_table (); # A table of watched properties
unique_props = REF []; # A list of unique property names
fun get_prop ()
=
get (0, *unique_props)
where
fun get (n, [])
=>
{ atom = ai::make_atom atom_imp (make_prop_name n);
unique_props := (atom, REF FALSE) ! *unique_props;
atom;
};
get (n, (atom, avail) ! r)
=>
if *avail
#
avail := FALSE;
atom;
else
get (n+1, r);
fi;
end;
end;
fun free_prop name
=
get *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;
# The X-event and request channels
#
xevent_slot = make_mailslot ();
plea_slot = make_mailslot ();
# Asynchronously send a message on a list of channels
#
fun broadcast ([], msg)
=>
();
broadcast (slot ! r, msg)
=>
{
make_thread "property imp broadcast" .{ give (slot, msg); };
broadcast (r, msg);
};
end;
# Handle a selection related X-event
#
fun do_xevent (xe::x::PROPERTY_NOTIFY { changed_window_id, atom, timestamp, deleted } )
=>
case (find_prop (prop_table, changed_window_id, atom), deleted)
#
(THE { watchers, ... }, FALSE)
=>
broadcast (watchers, (NEW_VALUE, timestamp));
(THE { watchers, is_unique, ... }, TRUE)
=>
{ broadcast (watchers, (DELETED, timestamp));
remove_prop (prop_table, changed_window_id, atom);
if is_unique free_prop atom; fi;
};
(NULL, _) => ();
esac;
do_xevent xevent
=>
xgripe::impossible "window_property_imp::make_server::do_xevent";
end;
fun do_plea (WATCH_PROP { name, window, is_unique, notify_slot } )
=>
insert_watcher (prop_table, window, name, notify_slot, is_unique);
do_plea (ALLOC_PROP (window, reply_1shot))
=>
{ name = get_prop ();
insert_unique (prop_table, window, name);
set (reply_1shot, name);
};
end;
# The imp loop:
#
fun loop ()
=
for (;;) {
#
select [
#
take' xevent_slot ==> do_xevent,
take' plea_slot ==> do_plea
];
};
xlogger::make_thread "window_property_imp" loop;
(xevent_slot, WINDOW_PROPERTY_IMP { xsocket, plea_slot } );
}; # fun make_window_property_imp
fun plead (WINDOW_PROPERTY_IMP { plea_slot, ... }, plea)
=
give (plea_slot, plea);
# Return an event for monitoring
# changes to a property's state:
#
fun watch_property (imp, name, window, is_unique)
=
take' notify_slot
where
notify_slot = make_mailslot ();
plead (
imp,
WATCH_PROP { name, window, is_unique, notify_slot }
);
end;
# Generate a property on the specified window
# that is guaranteed to be unique.
fun unused_property (imp, window)
=
{ reply_1shot = make_oneshot_maildrop ();
plead (imp, ALLOC_PROP (window, reply_1shot));
get reply_1shot;
};
}; # package property-imp
end;