## iccc-property-old.pkg
#
# Support for the standard X ICCCM properties and types
# as defined in version 1.0 of the ICCCM. These routines
# can be used to build various property values, including
# the standard ones.
# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublibstipulate
package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package at = standard_x11_atoms; # standard_x11_atoms is from src/lib/x-kit/xclient/src/iccc/standard-x11-atoms.pkg package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkg package dt = draw_types_old; # draw_types_old is from src/lib/x-kit/xclient/src/window/draw-types-old.pkg package w8v = vector_of_one_byte_unts; # vector_of_one_byte_unts is from src/lib/std/src/vector-of-one-byte-unts.pkg package wh = window_manager_hint_old; # window_manager_hint_old is from src/lib/x-kit/xclient/src/iccc/window-manager-hint-old.pkg package v2w = value_to_wire; # value_to_wire is from src/lib/x-kit/xclient/src/wire/value-to-wire.pkgherein
package iccc_property_old
: (weak) Iccc_Property_Old # Iccc_Property_Old is from src/lib/x-kit/xclient/src/iccc/iccc-property-old.api {
my (|) = unt::bitwise_or;
infix my | ;
fun word_to_vec x
=
{ w = unt::to_large_unt x;
fun get8 n
=
one_byte_unt::from_large_unt (large_unt::(>>) (w, n));
w8v::from_list [get8 0u24, get8 0u16, get8 0u8, get8 0u0];
};
# Convert an rw_vector of unts
# to an vector_of_one_byte_unts::vector:
#
fun arr_to_vec arr
=
f (rw_vector::length arr, [])
where
fun f (0, l)
=>
w8v::from_list l;
f (i, l)
=>
{ i = i - 1;
w = unt::to_large_unt (rw_vector::get (arr, i));
fun get8 n = one_byte_unt::from_large_unt (large_unt::(>>) (w, n));
b0 = get8 0u0;
b1 = get8 0u8;
b2 = get8 0u16;
b3 = get8 0u24;
f (i, b3 ! b2 ! b1 ! b0 ! l);
};
end;
end;
# Map a list of hints to an unt rw_vector,
# with position 0 containing the field mask
# and the other positions containing the
# field values:
#
fun make_hint_data (size, put_hint) lst
=
{ data = rw_vector::make_rw_vector (size, 0u0);
put1 = put_hint (\\ (i, x) = rw_vector::set (data, i, x));
fun put ( [], m) => m;
put (x ! r, m) => put (r, put1 (x, m));
end;
mask = put (lst, 0u0);
rw_vector::set (data, 0, mask);
arr_to_vec data;
};
# Build a property value
# of type STRING:
#
fun make_string_property data
=
xt::PROPERTY_VALUE
{
type => at::string,
#
value => xt::RAW_DATA { format => xt::RAW08,
data => byte::string_to_bytes data
}
};
# Build a property value
# of type ATOM:
#
fun make_atom_property (xt::XATOM v)
=
xt::PROPERTY_VALUE
{
type => at::atom,
value => xt::RAW_DATA { format => xt::RAW32,
data => word_to_vec v
}
};
stipulate
size_hints_data
=
make_hint_data (18, put_hint)
where
fun put_hint upd
=
put1
where
fun put_size (i, { wide, high } )
=
{ upd (i, unt::from_int wide);
upd (i+1, unt::from_int high);
};
fun put1 (wh::HINT_USPOSITION, m) => (m | 0u1);
put1 (wh::HINT_PPOSITION, m) => (m | 0u2);
put1 (wh::HINT_USSIZE, m) => (m | 0u4);
put1 (wh::HINT_PSIZE, m) => (m | 0u8);
put1 (wh::HINT_PMIN_SIZE size, m) => { put_size (5, size); m | 0u16;};
put1 (wh::HINT_PMAX_SIZE size, m) => { put_size (7, size); m | 0u32;};
put1 (wh::HINT_PRESIZE_INC size, m) => { put_size (9, size); m | 0u64;};
put1 (wh::HINT_PASPECT { min=>(x1, y1), max=>(x2, y2) }, m)
=>
{ upd (11, unt::from_int x1); upd (12, unt::from_int y1);
upd (13, unt::from_int x2); upd (14, unt::from_int y2);
m | 0u128;
};
put1 (wh::HINT_PBASE_SIZE size, m)
=>
{ put_size (15, size);
m | 0u256;
};
put1 (wh::HINT_PWIN_GRAVITY g, m)
=>
{ upd (17, v2w::gravity_to_wire g);
m | 0u512;
};
end;
end;
end;
herein
fun make_window_manager_size_hints lst
=
xt::PROPERTY_VALUE
{
type => at::wm_size_hints,
value => xt::RAW_DATA { format => xt::RAW32, data => size_hints_data lst }
};
end; # stipulate
stipulate
nonsize_hints_data
=
make_hint_data (9, put_hint)
where
fun put_hint upd (hint, m)
=
case hint
#
wh::HINT_INPUT TRUE => { upd (1, 0u1); m | 0u1; };
wh::HINT_WITHDRAWN_STATE => { upd (2, 0u0); m | 0u2; };
wh::HINT_NORMAL_STATE => { upd (2, 0u1); m | 0u2; };
wh::HINT_ICONIC_STATE => { upd (2, 0u3); m | 0u2; };
wh::HINT_ICON_RO_PIXMAP (dt::RO_PIXMAP ({ pixmap_id => pix, ... }: dt::Rw_Pixmap))
=>
{ upd (3, xt::xid_to_unt pix);
m | 0u4;
};
wh::HINT_ICON_PIXMAP ({ pixmap_id => pix, ... }: dt::Rw_Pixmap)
=>
{ upd (3, xt::xid_to_unt pix);
m | 0u4;
};
wh::HINT_ICON_WINDOW ({ window_id => window, ... }: dt::Window)
=>
{ upd (4, xt::xid_to_unt window);
m | 0u8;
};
wh::HINT_ICON_POSITION ({ col, row } )
=>
{ upd (5, unt::from_int col);
upd (6, unt::from_int row);
m | 0u16;
};
wh::HINT_ICON_MASK ({ pixmap_id => pix, ... }: dt::Rw_Pixmap)
=>
{ upd (7, xt::xid_to_unt pix);
m | 0u32;
};
wh::HINT_WINDOW_GROUP ({ window_id => window, ... }: dt::Window)
=>
{ upd (8, xt::xid_to_unt window);
m | 0u64;
};
_ => raise exception (xgripe::XERROR "Bad WM Hint");
esac;
end;
herein
fun make_window_manager_nonsize_hints lst
=
xt::PROPERTY_VALUE {
type => at::wm_hints,
value => xt::RAW_DATA { format => xt::RAW32, data => nonsize_hints_data lst }
};
end;
# Build a command-line argument property:
#
fun make_command_hints args
=
make_string_property
(string::cat
(map
(\\ s = s + "\000")
args
)
);
fun make_transient_hint ({ window_id=> window, ... }: dt::Window )
=
xt::PROPERTY_VALUE
{
type => at::window,
value => xt::RAW_DATA { format => xt::RAW32,
data => word_to_vec (xt::xid_to_unt window)
}
};
}; # package iccc_property
end;