## window-old.pkg
#
# See also:
# src/lib/x-kit/xclient/src/window/ro-pixmap-old.pkg# src/lib/x-kit/xclient/src/window/cs-pixmap-old.pkg# src/lib/x-kit/xclient/src/window/rw-pixmap-old.pkg# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib### "The first rule of discovery is to have brains and good luck.
### The second rule of discovery is to sit tight and wait till you get a bright idea."
###
### -- Geore Polya
stipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package at = atom_old; # atom_old is from src/lib/x-kit/xclient/src/iccc/atom-old.pkg package cs = cursors_old; # cursors_old is from src/lib/x-kit/xclient/src/window/cursors-old.pkg package di = draw_imp_old; # draw_imp_old is from src/lib/x-kit/xclient/src/window/draw-imp-old.pkg package dt = draw_types_old; # draw_types_old is from src/lib/x-kit/xclient/src/window/draw-types-old.pkg package dy = display_old; # display_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 g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package ip = iccc_property_old; # iccc_property_old is from src/lib/x-kit/xclient/src/iccc/iccc-property-old.pkg package s2w = sendevent_to_wire; # sendevent_to_wire is from src/lib/x-kit/xclient/src/wire/sendevent-to-wire.pkg package sa = standard_x11_atoms; # standard_x11_atoms is from src/lib/x-kit/xclient/src/iccc/standard-x11-atoms.pkg package sn = xsession_old; # xsession_old is from src/lib/x-kit/xclient/src/window/xsession-old.pkg package s2t = xsocket_to_hostwindow_router_old; # xsocket_to_hostwindow_router_old is from src/lib/x-kit/xclient/src/window/xsocket-to-hostwindow-router-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.pkg package wr = hostwindow_to_widget_router_old; # hostwindow_to_widget_router_old is from src/lib/x-kit/xclient/src/window/hostwindow-to-widget-router-old.pkg package xok = xsocket_old; # xsocket_old is from src/lib/x-kit/xclient/src/wire/xsocket-old.pkg package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkg package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkg #
trace = xtr::log_if xtr::io_logging 0; # Conditionally write strings to tracing.log or whatever.
#
# To debug via tracelogging, near startup to
#
# enable xtr::io_logging;
#
# and then annotate the code with lines like
#
# trace {. sprintf "foo/top: bar d=%d" bar; };
#
herein
package window_old
: (weak) Window_Old # Window_Old is from src/lib/x-kit/xclient/src/window/window-old.api {
Window = dt::Window;
# Set the value of a property:
#
fun set_property (xsession, window_id, name, value)
=
sn::send_xrequest xsession
#
(v2w::encode_change_property
{
window_id,
name,
property => value,
mode => xt::REPLACE_PROPERTY
}
);
# User-level window attributes:
#
package a {
Window_Attribute
#
= BACKGROUND_NONE
| BACKGROUND_PARENT_RELATIVE
| BACKGROUND_RW_PIXMAP dt::Rw_Pixmap
| BACKGROUND_RO_PIXMAP dt::Ro_Pixmap
| BACKGROUND_COLOR rgb::Rgb
#
| BORDER_COPY_FROM_PARENT
| BORDER_RW_PIXMAP dt::Rw_Pixmap
| BORDER_RO_PIXMAP dt::Ro_Pixmap
| BORDER_COLOR rgb::Rgb
#
| BIT_GRAVITY xt::Gravity
| WINDOW_GRAVITY xt::Gravity
#
| CURSOR_NONE
| CURSOR cs::Xcursor
;
};
# Window configuration values:
#
package c {
Window_Config
#
= ORIGIN g2d::Point
| SIZE g2d::Size
| BORDER_WID Int
| STACK_MODE xt::Stack_Mode
| REL_STACK_MODE (dt::Window, xt::Stack_Mode)
;
};
# Extract the Rgb8 from a color:
#
fun rgb8_of rgb
=
rgb8::rgb8_from_rgb rgb;
# Map user-level window attributes
# to internal x-window attributes:
#
fun user_window_attribute_to_internal_window_attribute (a::BACKGROUND_NONE)
=>
xt::a::BACKGROUND_PIXMAP_NONE;
user_window_attribute_to_internal_window_attribute (a::BACKGROUND_PARENT_RELATIVE)
=>
xt::a::BACKGROUND_PIXMAP_PARENT_RELATIVE;
user_window_attribute_to_internal_window_attribute (a::BACKGROUND_RW_PIXMAP ({ pixmap_id, ... }: dt::Rw_Pixmap))
=>
xt::a::BACKGROUND_PIXMAP pixmap_id;
user_window_attribute_to_internal_window_attribute (a::BACKGROUND_RO_PIXMAP (dt::RO_PIXMAP ({ pixmap_id, ... }: dt::Rw_Pixmap)))
=>
xt::a::BACKGROUND_PIXMAP pixmap_id;
user_window_attribute_to_internal_window_attribute (a::BACKGROUND_COLOR color)
=>
xt::a::BACKGROUND_PIXEL (rgb8_of color);
user_window_attribute_to_internal_window_attribute (a::BORDER_COPY_FROM_PARENT)
=>
xt::a::BORDER_PIXMAP_COPY_FROM_PARENT;
user_window_attribute_to_internal_window_attribute (a::BORDER_RW_PIXMAP ({ pixmap_id, ... }: dt::Rw_Pixmap))
=>
xt::a::BORDER_PIXMAP pixmap_id;
user_window_attribute_to_internal_window_attribute (a::BORDER_RO_PIXMAP (dt::RO_PIXMAP ({ pixmap_id, ... }: dt::Rw_Pixmap)))
=>
xt::a::BORDER_PIXMAP pixmap_id;
user_window_attribute_to_internal_window_attribute (a::BORDER_COLOR color)
=>
xt::a::BORDER_PIXEL (rgb8_of color);
user_window_attribute_to_internal_window_attribute (a::BIT_GRAVITY g)
=>
xt::a::BIT_GRAVITY g;
user_window_attribute_to_internal_window_attribute (a::WINDOW_GRAVITY g)
=>
xt::a::WINDOW_GRAVITY g;
user_window_attribute_to_internal_window_attribute (a::CURSOR_NONE)
=>
xt::a::CURSOR_NONE;
user_window_attribute_to_internal_window_attribute (a::CURSOR (cs::XCURSOR { id, ... } ))
=>
xt::a::CURSOR id;
end;
map_attributes
=
list::map user_window_attribute_to_internal_window_attribute;
standard_xevent_mask
=
xet::mask_of_xevent_list
[
xet::n::KEY_PRESS,
xet::n::KEY_RELEASE,
xet::n::BUTTON_PRESS,
xet::n::BUTTON_RELEASE,
xet::n::POINTER_MOTION,
xet::n::ENTER_WINDOW,
xet::n::LEAVE_WINDOW,
xet::n::EXPOSURE,
xet::n::STRUCTURE_NOTIFY,
xet::n::SUBSTRUCTURE_NOTIFY,
xet::n::PROPERTY_CHANGE
];
popup_xevent_mask
=
xet::mask_of_xevent_list
[
xet::n::EXPOSURE,
xet::n::STRUCTURE_NOTIFY,
xet::n::SUBSTRUCTURE_NOTIFY
];
exception BAD_WINDOW_SITE;
fun check_site g
=
if (g2d::valid_site g) g;
else raise exception BAD_WINDOW_SITE;
fi;
# Create a new X-window with the given xid
#
fun create_window (xsocket: xok::Xsocket)
{
window_id: xt::Window_Id,
parent_window_id: xt::Window_Id,
visual_id: xt::Visual_Id_Choice,
#
io_class: xt::Io_Class,
depth: Int,
site: g2d::Window_Site,
attributes: List( xt::a::Window_Attribute )
}
=
xok::send_xrequest xsocket msg
where
msg = v2w::encode_create_window
{
window_id,
parent_window_id,
visual_id,
io_class,
depth,
site,
attributes
};
end;
# This was in window-io.pkg (phased out), but apparently is never used:
# fun map_window xsocket window_id
# =
# xok::send_xrequest xsocket (v2w::encode_map_window { window_id } );
fun change_window_attributes' xsocket (window_id, attributes)
=
{ xok::send_xrequest xsocket
#
(v2w::encode_change_window_attributes { window_id, attributes });
xok::flush_xsocket xsocket;
};
fun make_simple_top_window (screen as { screen_info, xsession }: sn::Screen )
=
create_fn
where
screen_info -> { xscreen => { root_window_id, ... }: dy::Xscreen, rootwindow_per_depth_imps, ... }: sn::Screen_Info;
rootwindow_per_depth_imps -> { depth, ... }: sn::Per_Depth_Imps;
xsession -> { xdisplay => { xsocket, next_xid, ... }: dy::Xdisplay, ... }: sn::Xsession;
window_id = next_xid ();
fun create_fn { site, border_color, background_color }
=
{
my (kidplug, window, wm_window_delete_slot)
=
wr::make_hostwindow_to_widget_router
#
(screen, rootwindow_per_depth_imps, window_id, site);
create_window xsocket
{
depth,
#
window_id,
parent_window_id => root_window_id,
#
io_class => xt::INPUT_OUTPUT,
visual_id => xt::SAME_VISUAL_AS_PARENT,
#
site => check_site site,
#
attributes
=>
[ xt::a::BORDER_PIXEL (rgb8_of border_color),
xt::a::BACKGROUND_PIXEL background_color,
xt::a::EVENT_MASK standard_xevent_mask
]
};
(window, kidplug, wm_window_delete_slot);
};
end;
fun make_simple_subwindow ({ window_id=>parent_window_id, screen, to_hostwindow_drawimp, per_depth_imps, ... }: dt::Window )
=
create_fn
where
screen -> { xsession=>{ xdisplay => { xsocket, next_xid, ... }: dy::Xdisplay, ... }: sn::Xsession, ... }: sn::Screen;
window_id = next_xid ();
window = { window_id,
screen,
to_hostwindow_drawimp,
per_depth_imps
}
: dt::Window;
per_depth_imps -> { depth, ... }: sn::Per_Depth_Imps;
fun create_fn { site, border_color, background_color }
=
{ border_pixel
=
case border_color
#
NULL => xt::a::BORDER_PIXMAP_COPY_FROM_PARENT;
THE c => xt::a::BORDER_PIXEL (rgb8_of c);
esac;
background_pixel
=
case background_color
#
NULL => xt::a::BACKGROUND_PIXMAP_PARENT_RELATIVE;
THE c => xt::a::BACKGROUND_PIXEL c;
esac;
create_window xsocket
{
window_id,
parent_window_id,
#
io_class => xt::INPUT_OUTPUT,
depth,
#
visual_id => xt::SAME_VISUAL_AS_PARENT,
site => check_site site,
#
attributes => [
border_pixel,
background_pixel,
xt::a::EVENT_MASK standard_xevent_mask
]
};
window;
};
end;
# Create a simple popup window.
#
# These are simple windows used for menus
# and tooltips and such; they are neither
# registered with nor decorated by the
# window manager.
#
# Compare with the plain and transient
# windows provided by the hostwindow package:
#
# src/lib/x-kit/widget/old/basic/hostwindow.pkg #
fun make_simple_popup_window
(screen as { screen_info, xsession }: sn::Screen )
{ site, border_color, background_color }
=
(window, kidplug)
where
screen_info -> { xscreen => { root_window_id, ... }: dy::Xscreen, rootwindow_per_depth_imps, ... }: sn::Screen_Info;
rootwindow_per_depth_imps -> { depth, ... }: sn::Per_Depth_Imps;
xsession -> { xdisplay => { xsocket, next_xid, ... }: dy::Xdisplay, ... }: sn::Xsession;
window_id = next_xid();
my (kidplug, window, wm_window_delete_slot)
=
wr::make_hostwindow_to_widget_router (screen, rootwindow_per_depth_imps, window_id, site);
create_window xsocket
{
window_id,
parent_window_id => root_window_id,
#
io_class => xt::INPUT_OUTPUT,
depth,
#
visual_id => xt::SAME_VISUAL_AS_PARENT,
site => check_site site,
#
attributes => [
xt::a::OVERRIDE_REDIRECT TRUE,
xt::a::SAVE_UNDER TRUE,
xt::a::BORDER_PIXEL (rgb8_of border_color),
xt::a::BACKGROUND_PIXEL background_color,
xt::a::EVENT_MASK popup_xevent_mask
]
};
end;
# Create a simple transient window:
#
fun make_transient_window prop_window { site, border_color, background_color }
=
(window, kidplug)
where
prop_window -> { window_id=>id, screen=>screen as { screen_info, xsession }: sn::Screen, ... }: dt::Window;
screen_info -> { xscreen => { root_window_id, ... }: dy::Xscreen, rootwindow_per_depth_imps, ... }: sn::Screen_Info;
rootwindow_per_depth_imps -> { depth, ... }: sn::Per_Depth_Imps;
xsession -> { xdisplay => { xsocket, next_xid, ... }: dy::Xdisplay, ... }: sn::Xsession;
window_id = next_xid();
(wr::make_hostwindow_to_widget_router (screen, rootwindow_per_depth_imps, window_id, site))
->
(kidplug, window, wm_window_delete_slot);
create_window xsocket
{
window_id,
parent_window_id => root_window_id,
#
io_class => xt::INPUT_OUTPUT,
depth,
#
visual_id => xt::SAME_VISUAL_AS_PARENT,
site => check_site site,
#
attributes => [
xt::a::BORDER_PIXEL (rgb8_of border_color),
xt::a::BACKGROUND_PIXEL background_color,
xt::a::EVENT_MASK standard_xevent_mask
]
};
set_property (xsession, window_id, sa::wm_transient_for, ip::make_transient_hint prop_window);
end;
exception OP_UNSUPPORTED_ON_INPUT_ONLY_WINDOWS;
fun make_input_only_window window ({ col, row, wide, high } )
=
window
where
window -> { window_id=>parent_window_id, screen, per_depth_imps, to_hostwindow_drawimp, ... }: dt::Window;
screen -> { xsession=>{ xdisplay => { xsocket, next_xid, ... }: dy::Xdisplay, ... }: sn::Xsession, ... }: sn::Screen;
window_id = next_xid();
fun draw_fn (arg as (di::d::DESTROY _))
=>
to_hostwindow_drawimp arg;
draw_fn _
=>
raise exception OP_UNSUPPORTED_ON_INPUT_ONLY_WINDOWS;
end;
window
=
{
window_id,
screen,
to_hostwindow_drawimp => draw_fn,
per_depth_imps
}: dt::Window;
create_window xsocket
{
window_id,
parent_window_id,
#
io_class => xt::INPUT_ONLY,
depth => 0,
#
visual_id => xt::SAME_VISUAL_AS_PARENT,
attributes => [xt::a::EVENT_MASK standard_xevent_mask],
#
site => check_site
( { upperleft => { col, row },
size => { wide, high },
border_thickness => 0
}
: g2d::Window_Site
)
};
end;
# commandline is from src/lib/std/commandline.pkg # Set the standard window-manager
# properties of a top-level window.
#
# This should be done before showing
# (mapping) the window:
#
fun set_window_manager_properties
window
{ window_name,
icon_name,
commandline_arguments, # Typically from: commandline::get_arguments ().
size_hints,
nonsize_hints,
class_hints
}
=
{ window -> { window_id, screen => { xsession, ... }: sn::Screen, ... }: dt::Window;
fun put_property (name, value)
=
set_property (xsession, window_id, name, value);
fun put_string_prop (_, NULL) => ();
put_string_prop (atom, THE s) => put_property (atom, ip::make_string_property s);
end;
put_string_prop (sa::wm_name, window_name);
put_string_prop (sa::wm_icon_name, icon_name);
put_property (sa::wm_normal_hints, ip::make_window_manager_size_hints size_hints);
put_property (sa::wm_hints, ip::make_window_manager_nonsize_hints nonsize_hints);
case class_hints
#
THE { resource_name, resource_class }
=>
put_property
( sa::wm_ilk,
ip::make_string_property (string::cat [resource_name, "\000", resource_class])
);
NULL => ();
esac;
case commandline_arguments
#
[] => ();
_ => put_property
( sa::wm_command,
ip::make_command_hints commandline_arguments
);
esac;
};
# Set the window-manager protocols for a window:
#
fun set_window_manager_protocols window atoml
=
{ window -> { window_id, screen => { xsession, ... }: sn::Screen, ... }: dt::Window;
#
fun put_property n a
=
set_property (xsession, window_id, n, ip::make_atom_property a);
case (at::find_atom xsession "WM_PROTOCOLS")
#
NULL => FALSE;
THE protocols_atom => { apply (put_property protocols_atom) atoml; TRUE;};
esac;
};
# Map window configuration values to a value list:
#
fun do_config_val arr
=
{ fun upd (i, v)
=
rw_vector::set (arr, i, THE v);
\\ (c::ORIGIN ({ col, row } ))
=>
{ upd (0, unt::from_int col);
upd (1, unt::from_int row);
};
(c::SIZE ({ wide, high } ))
=>
{ upd (2, unt::from_int wide);
upd (3, unt::from_int high);
};
(c::BORDER_WID wide)
=>
upd (4, unt::from_int wide);
(c::STACK_MODE mode)
=>
{ rw_vector::set (arr, 5, NULL);
upd (6, v2w::stack_mode_to_wire mode);
};
(c::REL_STACK_MODE ({ window_id => xid, ... }: dt::Window, mode))
=>
{ upd (5, xt::xid_to_unt xid);
upd (6, v2w::stack_mode_to_wire mode);
};
end;
};
do_config_vals
=
v2w::do_val_list 7 do_config_val;
fun configure_window ({ window_id, screen => { xsession, ... }: sn::Screen, ... }: dt::Window ) vals
=
sn::send_xrequest xsession
( v2w::encode_configure_window
{
window_id,
vals => do_config_vals vals
}
);
fun move_window window pt = configure_window window [c::ORIGIN pt];
fun resize_window window size = configure_window window [c::SIZE size];
fun move_and_resize_window window ({ col, row, wide, high } )
=
configure_window window
[ c::ORIGIN ({ col, row } ),
c::SIZE ( { wide, high } )
];
# Show ("map") a window:
#
fun show_window ({ window_id, screen => { xsession, ... }: sn::Screen, ... }: dt::Window )
=
{
# window_id -> xid;
# trace {. sprintf "window-old.pkg: show_window: Calling v2w::encode_map_window { window_id => %d }" (xt::xid_to_int xid); };
sn::send_xrequest xsession (v2w::encode_map_window { window_id } );
sn::flush_out xsession;
};
# Hide ("unmap") a window:
#
fun hide_window ({ window_id, screen => { xsession, ... }: sn::Screen, ... }: dt::Window )
=
{ sn::send_xrequest xsession (v2w::encode_unmap_window { window_id } );
sn::flush_out xsession;
};
# Withdraw (unmap and notify window manager) a top-level window
#
stipulate
mask = xet::mask_of_xevent_list
[ xet::n::SUBSTRUCTURE_NOTIFY,
xet::n::SUBSTRUCTURE_REDIRECT
];
herein
fun withdraw_window ({ window_id, screen => { screen_info => { xscreen, ... }: sn::Screen_Info, xsession }: sn::Screen, ... }: dt::Window )
=
{ xscreen -> { root_window_id, ... }: dy::Xscreen;
sn::send_xrequest xsession
#
(s2w::encode_send_unmapnotify_xevent
{
send_event_to => xt::SEND_EVENT_TO_WINDOW root_window_id,
#
from_configure => FALSE,
propagate => FALSE,
event_mask => mask,
#
event_window_id => root_window_id,
unmapped_window_id => window_id
}
);
sn::flush_out xsession;
};
end;
# Destroy a window.
# We do this via draw_imp to avoid a race
# with any pending draw requests on the window.
#
fun destroy_window ({ window_id, to_hostwindow_drawimp, ... }: dt::Window )
=
to_hostwindow_drawimp (di::d::DESTROY (di::i::WINDOW window_id));
# Map a point in the window's coordinate
# system to the screen's coordinate system
#
window_point_to_screen_point
=
sn::window_point_to_screen_point;
# Set the window cursor:
#
fun set_cursor ({ window_id, screen, ... }: dt::Window ) c
=
{ screen -> { xsession => { xdisplay => { xsocket, ... }: dy::Xdisplay, ... }: sn::Xsession, ... }: sn::Screen;
cur = case c
#
THE (cs::XCURSOR { id, ... } ) => xt::a::CURSOR id;
NULL => xt::a::CURSOR_NONE;
esac;
change_window_attributes' xsocket (window_id, [cur]);
};
# Set the background color attribute of the window.
#
# Note that this does not immediately affect
# the window's contents, but if it is done
# before the window is mapped the window will
# come up with the right color.
#
fun set_background_color ({ window_id, screen, ... }: dt::Window ) color
=
change_window_attributes' xsocket (window_id, [color])
where
screen -> { xsession=>{ xdisplay => { xsocket, ... }: dy::Xdisplay, ... }: sn::Xsession, ... }: sn::Screen;
color
=
case color
#
THE c => xt::a::BACKGROUND_PIXEL (rgb8_of c);
NULL => xt::a::BACKGROUND_PIXMAP_PARENT_RELATIVE;
esac;
end;
# Set various window attributes
#
fun change_window_attributes ({ window_id, screen, ... }: dt::Window )
=
{ screen -> { xsession=>{ xdisplay => { xsocket, ... }: dy::Xdisplay, ... }: sn::Xsession, ... }: sn::Screen;
change = change_window_attributes' xsocket;
\\ attributes = change (window_id, map user_window_attribute_to_internal_window_attribute attributes);
};
fun screen_of_window ({ screen, ... }: dt::Window )
=
screen;
fun xsession_of_window ({ screen => { xsession, ... }: sn::Screen, ... }: dt::Window )
=
xsession;
# Added ddeboer Jan 2005
# grabKeyboard: we would like a reply of xprottypes::GrabSuccess
#
fun grab_keyboard ({ window_id, screen => { xsession, ... }: sn::Screen, ... }: dt::Window )
=
0;
# # commented out, ddeboer, mar 2005 - this needs reworked. XXX BUGGO FIXME
# let ans =
# (w2v::decode_grab_keyboard_reply (block_until_mailop_fires (sn::dpy_pequest_peply xsession
# (v2w::encode_grab_keyboard {
# window_id=id, * type xt::Xid *
# owner_events=FALSE,
# ptr_mode=xt::AsynchronousGrab,
# kbd_mode=xt::AsynchronousGrab,
# time=xt::CURRENT_TIME } ))))
# except Xok::LOST_REPLY => raise exception (xgripe::XERROR "[reply lost]")
# | (Xok::ERROR_REPLY err) =>
# raise exception (xgripe::XERROR (e2s::xerror_to_string err))
# in (case (ans) of
# xt::GrabSuccess => 0
# | xt::AlreadyGrabbed => 1
# | xt::GrabInvalidTime => 2
# | xt::GrabNotViewable => 3
# | xt::GrabFrozen => 4)
# end
fun ungrab_keyboard ({ window_id, screen => { xsession, ... }: sn::Screen, ... }: dt::Window )
=
{ ans = ( /* w2v::decode_grab_keyboard_reply */
(block_until_mailop_fires
(sn::send_xrequest_and_read_reply
xsession
(v2w::encode_ungrab_keyboard
{ time=>xt::CURRENT_TIME }
) ) ) )
except
xok::LOST_REPLY => raise exception (xgripe::XERROR "[reply lost]");
xok::ERROR_REPLY err => raise exception (xgripe::XERROR (e2s::xerror_to_string err));
end ;
# TODO: figure out what type of reply comes from an ungrab request, and decode it XXX BUGGO FIXME
0;
};
# end added ddeboer
# Get size of window plus its location
# relative to parent:
#
fun get_window_site
({ window_id, screen => { xsession as { xsocket_to_hostwindow_router, ... }: sn::Xsession, ... }: sn::Screen, ... }: dt::Window)
=
s2t::get_window_site (xsocket_to_hostwindow_router, window_id);
# {
# log::note_in_ramlog {. "get_window_site/AAA -- window-old.pkg"; };
# result =
# s2t::get_window_site (xsocket_to_hostwindow_router, window_id);
# log::note_in_ramlog {. "get_window_site/ZZZ -- window-old.pkg"; };
# result;
# };
# Convenience wrappers for the corresponding functions in
# src/lib/x-kit/xclient/src/window/xsession-old.api #
fun send_fake_key_press_xevent (arg as { window => ({ screen => { xsession, ... }: sn::Screen, ... }: dt::Window), ... }) = sn::send_fake_key_press_xevent xsession arg;
fun send_fake_key_release_xevent (arg as { window => ({ screen => { xsession, ... }: sn::Screen, ... }: dt::Window), ... }) = sn::send_fake_key_release_xevent xsession arg;
fun send_fake_mousebutton_press_xevent (arg as { window => ({ screen => { xsession, ... }: sn::Screen, ... }: dt::Window), ... }) = sn::send_fake_mousebutton_press_xevent xsession arg;
fun send_fake_mousebutton_release_xevent (arg as { window => ({ screen => { xsession, ... }: sn::Screen, ... }: dt::Window), ... }) = sn::send_fake_mousebutton_release_xevent xsession arg;
fun send_fake_mouse_motion_xevent (arg as { window => ({ screen => { xsession, ... }: sn::Screen, ... }: dt::Window), ... }) = sn::send_fake_mouse_motion_xevent xsession arg;
fun send_fake_''mouse_enter''_xevent (arg as { window => ({ screen => { xsession, ... }: sn::Screen, ... }: dt::Window), ... }) = sn::send_fake_''mouse_enter''_xevent xsession arg;
fun send_fake_''mouse_leave''_xevent (arg as { window => ({ screen => { xsession, ... }: sn::Screen, ... }: dt::Window), ... }) = sn::send_fake_''mouse_leave''_xevent xsession arg;
# This call is infrastructure.
#
# We often want to wait until a widget is fully
# operational before sending pleas to it.
#
# A practical definition of "operational" is
# "has received its first EXPOSE X event".
#
# We maintain a oneshot in widgets which
# clients may wait on for this purpose; see
# seen_first_redraw_oneshot_of
# in
# src/lib/x-kit/widget/old/basic/widget.api #
# The oneshot in question originates at widget
# creation time -- make_widget in
#
# src/lib/x-kit/widget/old/basic/widget.pkg #
# At realization time, which is when a widget
# for the first time becomes associated with an
# X window, it registers its oneshot with us
# via this call: See realize_widget in widget.pkg.
# This ensures that we have the onehost on hand
# when we receive a window's first EXPOSE event.
#
fun note_''seen_first_expose''_oneshot
({ window_id, screen => { xsession as { xsocket_to_hostwindow_router, ... }: sn::Xsession, ... }: sn::Screen, ... }: dt::Window)
seen_first_redraw
=
s2t::note_window's_''seen_first_expose''_oneshot
#
(xsocket_to_hostwindow_router, window_id, seen_first_redraw);
fun get_''seen_first_expose''_oneshot_of
#
({ window_id, screen => { xsession as { xsocket_to_hostwindow_router, ... }: sn::Xsession, ... }: sn::Screen, ... }: dt::Window)
=
s2t::get_''seen_first_expose''_oneshot_of
#
(xsocket_to_hostwindow_router, window_id);
fun get_''gui_startup_complete''_oneshot_of
#
({ window_id, screen => { xsession as { xsocket_to_hostwindow_router, ... }: sn::Xsession, ... }: sn::Screen, ... }: dt::Window)
=
s2t::get_''gui_startup_complete''_oneshot_of
#
xsocket_to_hostwindow_router;
}; # Window
end; # stipulate