## window-property-old.pkg
#
# This package is exported by
#
# src/lib/x-kit/xclient/xclient.pkg#
# as part of "Selection stuff".
# We have no other direct reference.
#
# Selection stuff clients include:
#
# src/lib/x-kit/widget/old/basic/hostwindow.pkg# src/lib/x-kit/widget/old/basic/root-window-old.pkg# src/lib/x-kit/tut/bouncing-heads/bouncing-heads-app.pkg# src/lib/x-kit/tut/triangle/triangle-app.pkg# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublibstipulate
include package 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/src/wire/xtypes.pkg package xe = xerrors; # xerrors is from src/lib/x-kit/xclient/src/wire/xerrors.pkg package wpi = window_property_imp_old; # window_property_imp_old is from src/lib/x-kit/xclient/src/window/window-property-imp-old.pkg package sn = xsession_old; # xsession_old is from src/lib/x-kit/xclient/src/window/xsession-old.pkg package dt = draw_types_old; # draw_types_old is from src/lib/x-kit/xclient/src/window/draw-types-old.pkg package xok = xsocket_old; # xsocket_old is from src/lib/x-kit/xclient/src/wire/xsocket-old.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.pkgherein
package window_property_old
: (weak) Window_Property_Old # Window_Property_Old is from src/lib/x-kit/xclient/src/iccc/window-property-old.api {
exception PROPERTY_ALLOCATE;
#
# Raised if there is not enough space to
# store a property value on the server.
# Given message encode and reply decode
# functions, send and receive a query
#
fun query (encode, decode) display
=
{ send_xrequest_and_read_reply
=
sn::send_xrequest_and_read_reply display;
fun ask msg
=
(decode (block_until_mailop_fires (send_xrequest_and_read_reply (encode msg))))
except
xok::LOST_REPLY
=>
raise exception (xgripe::XERROR "[reply lost]");
xok::ERROR_REPLY err
=>
raise exception (xgripe::XERROR (xerror_to_string::xerror_to_string err));
end ;
ask;
};
############################################
# Various protocol requests which we need:
req_get_property
=
query
( v2w::encode_get_property,
w2v::decode_get_property_reply
);
fun rotate_props display arg
=
sn::send_xrequest display
(v2w::encode_rotate_properties arg);
fun delete_prop display arg
=
sn::send_xrequest display
(v2w::encode_delete_property arg);
fun change_property display arg
=
{ ack = sn::send_xrequest_and_return_completion_mailop
display
(v2w::encode_change_property arg);
block_until_mailop_fires ack
except
xok::ERROR_REPLY (xe::XERROR { kind=>xe::BAD_ALLOC, ... } )
=>
raise exception PROPERTY_ALLOCATE;
ex =>
raise exception ex;
end ;
};
stipulate
package xt' : (weak) api {
Atom;
# raw data from server (in ClientMessage, property values, ...)
Raw_Format = RAW08 | RAW16 | RAW32;
Raw_Data = RAW_DATA {
format: Raw_Format,
data: vector_of_one_byte_unts::Vector
};
# X property values. A property value has a name and type, which are atoms,
# and a value. The value is a sequence of 8, 16 or 32-bit items, represented
# as a format and a string.
Property_Value = PROPERTY_VALUE {
type: Atom,
value: Raw_Data
};
}
=
xt;
herein
include package xt';
end;
# An abstract interface to a property on a window
#
Property
=
PROPERTY
{ xsession: sn::Xsession,
name: Atom,
window: xt::Window_Id,
is_unique: Bool
};
# Get the xsession and
# window ID from a window:
#
fun info_of_window ({ window_id, screen=> { xsession, ... }: sn::Screen, ... }: dt::Window )
=
(xsession, window_id);
# Get the property server of a display
fun prop_server ({ window_property_imp, ... }: sn::Xsession )
=
window_property_imp;
# Get the xsession, window id
# and atom from a property:
#
fun info_of_prop (PROPERTY { xsession, name, window, ... } )
=
(xsession, window, name);
# Return the abstract representation of the named property on
# the specified window.
#
fun property (window, name)
=
{ my (xsession, window_id)
=
info_of_window window;
PROPERTY { xsession, name, window=>window_id, is_unique=>FALSE };
};
# Generate a property on the
# specified window that is
# guaranteed to be unused:
#
fun unused_property window
=
{ my (xsession, window_id)
=
info_of_window window;
prop_name
=
wpi::unused_property
(
prop_server xsession,
window_id
);
PROPERTY
{ xsession,
name => prop_name,
window => window_id,
is_unique => TRUE
};
};
# Return the atom that
# names the given property:
#
fun name_of_property (PROPERTY { name, ... } )
=
name;
# Update a property:
#
fun update_prop mode (prop, value)
=
{ my (display, window_id, name)
=
info_of_prop prop;
change_property display
{ name,
mode,
window_id,
property => value
};
};
# Set the value of
# the property:
#
set_property
=
update_prop xt::REPLACE_PROPERTY;
# Append the property value
# to the property.
# The types must match:
#
append_to_property
=
update_prop xt::APPEND_PROPERTY;
# Prepend the property value
# to the property.
# The types must match.
#
prepend_to_property
=
update_prop xt::PREPEND_PROPERTY;
# Delete the named property:
#
fun delete_property prop
=
{ (info_of_prop prop)
->
(display, wid, name);
delete_prop display { window_id => wid, property => name };
};
# Create a new property initialized
# to the given value:
#
fun make_property (window, value)
=
{ prop = unused_property window;
#
set_property (prop, value); prop;
};
exception ROTATE_PROPERTIES;
# Rotate the list of properties:
#
fun rotate_properties ([], _)
=>
();
rotate_properties (l as prop ! r, n)
=>
{ (info_of_prop prop)
->
(display, window_id, _);
fun check_prop prop
=
{ (info_of_prop prop) -> (_, w, name);
#
if (w != window_id) raise exception ROTATE_PROPERTIES;
else name;
fi;
};
rotate_props display
{
window_id,
delta => n,
properties => map check_prop l
};
};
end;
# Get a property value, which
# may require several requests:
#
fun get_property property
=
get_prop ()
where
(info_of_prop property)
->
(display, window_id, name);
fun size_of (xt::RAW_DATA { data, ... } )
=
(vector_of_one_byte_unts::length data) / 4;
fun get_chunk words_so_far
=
req_get_property display
{
window_id,
property => name,
type => NULL, # AnyPropertyType
offset => words_so_far,
len => 1024,
delete => FALSE
};
fun extend_data (data', xt::RAW_DATA { data, ... } )
=
data ! data';
fun flatten_data (data', xt::RAW_DATA { format, data } )
=
xt::RAW_DATA {
format,
data=>vector_of_one_byte_unts::cat (reverse (data ! data'))
};
fun get_prop ()
=
case (get_chunk 0)
NULL => NULL;
THE { type, bytes_after, value as xt::RAW_DATA { data, ... } }
=>
if (bytes_after == 0) THE (PROPERTY_VALUE { type, value } );
else get_rest (size_of value, [data]);
fi;
esac
also
fun get_rest (words_so_far, data')
=
case (get_chunk words_so_far)
NULL => NULL;
THE { type, bytes_after, value }
=>
if (bytes_after == 0)
THE (PROPERTY_VALUE { type, value=>flatten_data (data', value) } );
else
get_rest(
words_so_far + size_of value,
extend_data (data', value));
fi;
esac;
end;
# Inherit the Property_Change sumtype:
#
Property_Change == wpi::Property_Change;
# stipulate
# package window_property_imp': (weak) api { Property_Change = NEW_VALUE | DELETED; }
# =
# window_property_imp_old;
# herein
# include package window_property_imp';
# end;
# Return an event for monitoring changes
# to a property's state:
#
fun watch_property (PROPERTY { xsession, name, window, is_unique } )
=
wpi::watch_property (prop_server xsession, name, window, is_unique);
# xrdb_of_screen: return the list of strings contained in the
# XA_RESOURCE_MANAGER property of the root screen of the
# specified screen.
# This should properly belong some other place than in ICCC,
# as it has nothing to do with ICCC, except that it accesses
# data in the screen type, and uses the GetProperty functions
# of ICCC. XXX SUCKO FIXME
#
fun xrdb_of_screen (screen: sn::Screen)
=
{ xsession = sn::xsession_of_screen screen;
root_window = sn::root_window_of_screen screen;
case (get_property
(PROPERTY
{ xsession,
name => standard_x11_atoms::resource_manager,
window => root_window,
is_unique => FALSE
}
) )
#
THE (PROPERTY_VALUE { type, value=>RAW_DATA { format, data } } )
=>
string::tokens
(\\ c
=
case (char::to_int c)
#
13 => TRUE; # CR
10 => TRUE; # lF
_ => FALSE;
esac
)
(byte::bytes_to_string data);
_ => [];
esac;
};
}; # package property
end;