## window.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 e2s = xerror_to_string; # xerror_to_string is from src/lib/x-kit/xclient/src/to-string/xerror-to-string.pkg package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.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 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 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 package xet = xevent_types; # xevent_types is from src/lib/x-kit/xclient/src/wire/xevent-types.pkg #
package at = atom; # atom is from src/lib/x-kit/xclient/src/iccc/atom.pkg package cs = cursors; # cursors is from src/lib/x-kit/xclient/src/window/cursors.pkg package di = xserver_ximp; # xserver_ximp is from src/lib/x-kit/xclient/src/window/xserver-ximp.pkg package w2x = windowsystem_to_xserver; # windowsystem_to_xserver is from src/lib/x-kit/xclient/src/window/windowsystem-to-xserver.pkg# package dt = draw_types; # draw_types is from src/lib/x-kit/xclient/src/window/draw-types.pkg package dy = display; # display is from src/lib/x-kit/xclient/src/wire/display.pkg package ip = iccc_property; # iccc_property is from src/lib/x-kit/xclient/src/iccc/iccc-property.pkg package sn = xsession_junk; # xsession_junk is from src/lib/x-kit/xclient/src/window/xsession-junk.pkg package s2t = xevent_router_ximp; # xevent_router_ximp is from src/lib/x-kit/xclient/src/window/xevent-router-ximp.pkg# package ewp = windowsystem_to_xevent_router; # windowsystem_to_xevent_router is from src/lib/x-kit/xclient/src/window/windowsystem-to-xevent-router.pkg# package wr = xevent_to_widget_ximp; # xevent_to_widget_ximp is from src/lib/x-kit/xclient/src/window/xevent-to-widget-ximp.pkg package x2s = xclient_to_sequencer; # xclient_to_sequencer is from src/lib/x-kit/xclient/src/wire/xclient-to-sequencer.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
: (weak) Window # Window is from src/lib/x-kit/xclient/src/window/window.api {
# Window = dt::Window;
# Set the value of a property:
#
fun set_property (x: sn::Xsession, window_id, name, value)
=
x.windowsystem_to_xserver.xclient_to_sequencer.send_xrequest
#
(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 sn::Rw_Pixmap
| BACKGROUND_RO_PIXMAP sn::Ro_Pixmap
| BACKGROUND_COLOR rgb::Rgb
#
| BORDER_COPY_FROM_PARENT
| BORDER_RW_PIXMAP sn::Rw_Pixmap
| BORDER_RO_PIXMAP sn::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 (sn::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, ... }: sn::Rw_Pixmap))
=>
xt::a::BACKGROUND_PIXMAP pixmap_id;
user_window_attribute_to_internal_window_attribute (a::BACKGROUND_RO_PIXMAP (sn::RO_PIXMAP ({ pixmap_id, ... }: sn::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, ... }: sn::Rw_Pixmap))
=>
xt::a::BORDER_PIXMAP pixmap_id;
user_window_attribute_to_internal_window_attribute (a::BORDER_RO_PIXMAP (sn::RO_PIXMAP ({ pixmap_id, ... }: sn::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 (x: sn::Xsession)
{
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 )
}
=
x.windowsystem_to_xserver.xclient_to_sequencer.send_xrequest msg
where
msg = v2w::encode_create_window # value_to_wire is from src/lib/x-kit/xclient/src/wire/value-to-wire.pkg { # value_to_wire_pith is from src/lib/x-kit/xclient/src/wire/value-to-wire-pith.pkg window_id,
parent_window_id,
visual_id,
io_class,
depth,
site,
attributes
};
end;
# fun map_window xsocket window_id # This was in window-io.pkg (phased out), but apparently is never used:
# = #
# xok::send_xrequest xsocket (v2w::encode_map_window { window_id } ); # This functionality is replicated in src/lib/x-kit/widget/xkit/app/guishim-imp-for-x.pkg fun change_window_attributes' (windowsystem_to_xserver: w2x::Windowsystem_To_Xserver) (window_id, attributes)
=
{ windowsystem_to_xserver.xclient_to_sequencer.send_xrequest
#
(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 -> sn::SCREEN_INFO { xscreen => { root_window_id, ... }: dy::Xscreen, rootwindow_per_depth_imps, ... };
# 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, ... }: sn::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
# }: sn::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 -> sn::SCREEN_INFO { xscreen => { root_window_id, ... }: dy::Xscreen, rootwindow_per_depth_imps, ... };
# 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, ... }: sn::Window;
# screen_info -> sn::SCREEN_INFO { xscreen => { root_window_id, ... }: dy::Xscreen, rootwindow_per_depth_imps, ... };
#
# 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::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, ... }: sn::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
# }: sn::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, ... }: sn::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, ... }: sn::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, ... }: sn::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 => (x: sn::Xsession), ... }: sn::Screen, ... }: sn::Window ) vals
=
x.windowsystem_to_xserver.xclient_to_sequencer.send_xrequest
( 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 => (x: sn::Xsession), ... }: sn::Screen, ... }: sn::Window )
=
{
# window_id -> xid;
# trace {. sprintf "window-old.pkg: show_window: Calling v2w::encode_map_window { window_id => %d }" (xt::xid_to_int xid); };
x.windowsystem_to_xserver.xclient_to_sequencer.send_xrequest (v2w::encode_map_window { window_id } );
# sn::flush_out xsession;
};
# Hide ("unmap") a window:
#
fun hide_window ({ window_id, screen => { xsession => (x: sn::Xsession), ... }: sn::Screen, ... }: sn::Window )
=
{ x.windowsystem_to_xserver.xclient_to_sequencer.send_xrequest (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 => (x: sn::Xsession) }: sn::Screen, ... }: sn::Window )
=
{ xscreen -> { root_window_id, ... }: dy::Xscreen;
#
x.windowsystem_to_xserver.xclient_to_sequencer.send_xrequest
#
(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, windowsystem_to_xserver, ... }: sn::Window )
=
windowsystem_to_xserver.destroy_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, ... }: sn::Window ) c
=
{ screen -> { xsession => (x: sn::Xsession), ... }: sn::Screen;
cur = case c
#
THE (cs::XCURSOR { id, ... } ) => xt::a::CURSOR id;
NULL => xt::a::CURSOR_NONE;
esac;
change_window_attributes' x.windowsystem_to_xserver (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, ... }: sn::Window) color
=
change_window_attributes' x.windowsystem_to_xserver (window_id, [color])
where
screen -> { xsession => (x: 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, ... }: sn::Window )
=
{ screen -> { xsession => (x: sn::Xsession), ... }: sn::Screen;
#
change = change_window_attributes' x.windowsystem_to_xserver;
\\ attributes = change (window_id, map user_window_attribute_to_internal_window_attribute attributes);
};
fun screen_of_window ({ screen, ... }: sn::Window )
=
screen;
fun xsession_of_window ({ screen => { xsession, ... }: sn::Screen, ... }: sn::Window )
=
xsession;
# Added ddeboer Jan 2005
# grabKeyboard: we would like a reply of xprottypes::GrabSuccess
#
fun grab_keyboard ({ window_id, screen => { xsession, ... }: sn::Screen, ... }: sn::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 => (x: sn::Xsession), ... }: sn::Screen, ... }: sn::Window )
=
{ ans = ( /* w2v::decode_grab_keyboard_reply */
(block_until_mailop_fires
# ======================== XXX SUCKO FIXME
(x.windowsystem_to_xserver.xclient_to_sequencer.send_xrequest_and_read_reply
(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 (x: sn::Xsession), ... }: sn::Screen, ... }: sn::Window)
=
x.windowsystem_to_xevent_router.get_window_site 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, ... }: sn::Window), ... }) = sn::send_fake_key_press_xevent xsession arg;
fun send_fake_key_release_xevent (arg as { window => ({ screen => { xsession, ... }: sn::Screen, ... }: sn::Window), ... }) = sn::send_fake_key_release_xevent xsession arg;
fun send_fake_mousebutton_press_xevent (arg as { window => ({ screen => { xsession, ... }: sn::Screen, ... }: sn::Window), ... }) = sn::send_fake_mousebutton_press_xevent xsession arg;
fun send_fake_mousebutton_release_xevent (arg as { window => ({ screen => { xsession, ... }: sn::Screen, ... }: sn::Window), ... }) = sn::send_fake_mousebutton_release_xevent xsession arg;
fun send_fake_mouse_motion_xevent (arg as { window => ({ screen => { xsession, ... }: sn::Screen, ... }: sn::Window), ... }) = sn::send_fake_mouse_motion_xevent xsession arg;
fun send_fake_''mouse_enter''_xevent (arg as { window => ({ screen => { xsession, ... }: sn::Screen, ... }: sn::Window), ... }) = sn::send_fake_''mouse_enter''_xevent xsession arg;
fun send_fake_''mouse_leave''_xevent (arg as { window => ({ screen => { xsession, ... }: sn::Screen, ... }: sn::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, ... }: sn::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 (x: sn::Xsession), ... }: sn::Screen, ... }: sn::Window)
=
x.windowsystem_to_xevent_router.get_''seen_first_expose''_oneshot_of window_id;
fun get_''gui_startup_complete''_oneshot_of
#
({ window_id, screen => { xsession as (x: sn::Xsession), ... }: sn::Screen, ... }: sn::Window)
=
x.windowsystem_to_xevent_router.get_''gui_startup_complete''_oneshot_of ();
}; # Window
end; # stipulate