## xsession-old.pkg
#
# This package has the highest-level responsibility for
# managing all the state and operations relating to
# communication with a given X server.
#
#
# Architecture
# ------------
#
# Nomenclature: An 'imp' is a server microthread.
# (Like a daemon but smaller!)
#
# A 'imp' is an X-specific imp.
#
# An xsocket is built of four imps.
# An xsession adds three more imps to make seven imps total.
# An xclient adds two more imps to make nine imps total.
# An X application adds an unbounded number of additional widget imps.
#
# Adapting from the page 8 diagram in
# http://mythryl.org/pub/exene/1991-ml-workshop.pdf
# our dataflow network for xsession looks like:
#
# ----------------------
# | X server process |
# ----------------------
# ^ |
# | v
# -------<network socket>------------- network and process boundary.
# ^ |xpackets
# |xpackets v --- --- ---
# --------------- --------------- . . .
# | outbuf_imp | | inbuf_imp | . . .
# --------------- --------------- . . .
# ^ | xpackets . . .
# | xpackets v . . .
# ------------------------------- . . .
# | sequencer_imp |--> (error handler) ... xsocket . .
# ------------------------------- . imps . .
# ^ ^ ^ | xpackets . . .
# | | | v . ... xsession .
# | | | ------------------------- . . imps .
# | | | | decode_xpackets_imp | . . .
# | | | ------------------------- . . .
# | | | | xevents --- . .
# v | | v . .
# ------------- | | ------------------------- --------------- . .
# | font_imp | | | | xevent_to_window_imp |--> | keymap_imp | . .
# ------------- | | ------------------------- --------------- . .
# ^ | | | xevents ^ ^ . .... xclient
# | | | | | | . . imps
# | | | | | | . .
# | | | | | | --- .
# | ------------------ | | | | .
# | | pen_imp | | | | | .
# | ------------------ | | | | .
# | ^ | | | | .
# | | | | | | .
# | v | | | | .
# | ------------------ | | | .
# | | draw_imp | | | | .
# | ------------------ | | | .
# | ^ | |get_window_site | .
# | | | xevents |note_new_hostwindow | ---
# v | v | v
# (.................................to/from widget threads......................................)
# ^ | ^ | ^ |
# |xrequests | xevents |xrequests | xevents |xrequests | xevents
# | v | v | v
# ------------------------- ------------------------- -------------------------
# | xevent_to_widget_imp | | xevent_to_widget_imp | | xevent_to_widget_imp | ...
# ------------------------- ------------------------- -------------------------
# / \ / \ / \
# / widget \ / widget \ / widget \
# / tree \ / tree \ / tree \
# / \ / \ / \
# / ... \ / ... \ / ... \
#
# Dramatis Personae:
#
# o The sequencer_imp matches replies to requests.
# All traffic to/from the X server goes through it.
# Implemented in: src/lib/x-kit/xclient/src/wire/xsocket-old.pkg#
# o The outbuf_imp optimizes network usage by
# combining multiple requests per network packet.
# Implemented in: src/lib/x-kit/xclient/src/wire/xsocket-old.pkg#
# o The inbuf_imp breaks the incoming bytestream
# into individual replies and forwards them individually
# to sequencer_imp.
# Implemented in: src/lib/x-kit/xclient/src/wire/xsocket-old.pkg#
# o The decode_xpackets_imp cracks raw wire-format bytestrings into
# xevent_types::x::Event values and combines multiple related Expose
# events into a single logical Expose event for ease of downstream
# processing.
# Implemented in: src/lib/x-kit/xclient/src/wire/xsocket-old.pkg#
# o The xevent_to_window_imp imp receives all X events
# (e.g. keystrokes and mouseclicks) and feeds each one to the
# appropriate toplevel window, or more precisely to the
# hostwindow_to_widget_router at the root of the widgettree for
# ("xevent_to_widget_imp" might be a better name)
# that window, there to trickle down the widgettree to its ultimate
# target widget.
#
# To do this, xevent_to_window_imp
# tracks all X windows created by the application,
# keyed by their X IDs. (Toplevel X windows are
# registered at creation by the window-old.pkg functions;
# subwindows are registered when their X notify event
# comes through.)
#
# Implemented in: src/lib/x-kit/xclient/src/window/xsocket-to-hostwindow-router-old.pkg# See also: src/lib/x-kit/xclient/src/window/hostwindow-to-widget-router-old.pkg#
# o The font_imp ...
# Implemented in: src/lib/x-kit/xclient/src/window/font-imp-old.pkg#
# o The keymap_imp ...
# Implemented in: src/lib/x-kit/xclient/src/window/keymap-imp-old.pkg#
#
# o The draw_imp buffers draw commands and combines
# them into subsequences which can share a single
# X server graphics context, in order to minimize
# the number of graphics context switches required.
# It works closely with the pen-to-gcontext-imp.
# Implemented in: src/lib/x-kit/xclient/src/window/draw-imp-old.pkg#
# o The pen_to_gcontext_imp maps between the immutable "pens"
# we provide to the application programmer and the mutable
# graphics contexts actually supported by the X server. Given
# a pen, it returns a matching graphics context, using an
# existing one unchanged if possible, else modifying an
# existing one appropropriately.
# Implemented in: src/lib/x-kit/xclient/src/window/pen-to-gcontext-imp-old.pkg#
#
# All mouse and keyboard events flow down through the
# inbuf, sequencer, decoder and xevent-to-window imps
# and thence down through the widget hierarchy
# associated with the relevant hostwindow.
#
# Client xserver requests and responses are sent
# directly to the sequencer imp, with the exception
# of font requests and responses, which run through
# the font imp.
#
# Keysym translations are handled by keymap_imp.
# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib### "I have always wished that my computer
### would be as easy to use as my telephone.
### My wish has come true ... I no longer
### know how to use my telephone."
###
### -- Bjarne Stroustrup
stipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.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 g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package xok = xsocket_old; # xsocket_old is from src/lib/x-kit/xclient/src/wire/xsocket-old.pkg package dy = display_old; # display_old is from src/lib/x-kit/xclient/src/wire/display-old.pkg package ai = atom_imp_old; # atom_imp_old is from src/lib/x-kit/xclient/src/iccc/atom-imp-old.pkg package cs = color_spec; # color_spec is from src/lib/x-kit/xclient/src/window/color-spec.pkg package di = draw_imp_old; # draw_imp_old is from src/lib/x-kit/xclient/src/window/draw-imp-old.pkg package fti = font_imp_old; # "fi" is taken! :-) # font_imp_old is from src/lib/x-kit/xclient/src/window/font-imp-old.pkg package p2g = pen_to_gcontext_imp_old; # pen_to_gcontext_imp_old is from src/lib/x-kit/xclient/src/window/pen-to-gcontext-imp-old.pkg package kab = keys_and_buttons; # keys_and_buttons is from src/lib/x-kit/xclient/src/wire/keys-and-buttons.pkg package ki = keymap_imp_old; # keymap_imp_old is from src/lib/x-kit/xclient/src/window/keymap-imp-old.pkg package si = selection_imp_old; # selection_imp_old is from src/lib/x-kit/xclient/src/window/selection-imp-old.pkg package v2w = value_to_wire; # value_to_wire is from src/lib/x-kit/xclient/src/wire/value-to-wire.pkg package s2w = sendevent_to_wire; # sendevent_to_wire is from src/lib/x-kit/xclient/src/wire/sendevent-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 wpi = window_property_imp_old; # window_property_imp_old is from src/lib/x-kit/xclient/src/window/window-property-imp-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.
# This is purely a temporary debug kludge to force this to compile:
#
Xsession_Ximps_Exports
=
xsession_ximps::Exports; # xession_ximps is from src/lib/x-kit/xclient/src/window/xsession-ximps.pkgherein
package xsession_old
: Xsession_Old # Xsession_Old is from src/lib/x-kit/xclient/src/window/xsession-old.api {
Per_Depth_Imps
=
# For each combination of visual and depth
# we allot a pair of imps, one to draw,
# one to manage graphics contexts. This
# is forced because X requires that each
# gc and pixmap be associated with a
# particular screen, visual and depth:
#
{ # The pen-to-gcontext imp and draw_imp
# # for a given depth, visual and screen.
depth: Int,
pen_imp: p2g::Pen_To_Gcontext_Imp, # The pen-to-gcontext imp for this depth on this screen.
to_screen_drawimp: di::d::Draw_Op -> Void # The rootwindow draw-imp for this depth on this screen.
};
Screen_Info
=
{
xscreen: dy::Xscreen, # Xscreen def in src/lib/x-kit/xclient/src/wire/display-old.pkg per_depth_imps: List( Per_Depth_Imps ), # The pen-to-gcontext and draw imps for the supported depths on this screen.
rootwindow_per_depth_imps: Per_Depth_Imps # The pen-to-gcontext and draw imps for the root window on this screen.
};
Xsession
=
{
xdisplay: dy::Xdisplay, #
screens: List( Screen_Info ),
default_screen_info: Screen_Info,
xsocket_to_hostwindow_router: s2t::Xsocket_To_Hostwindow_Router, # Feeds X events to appropriate toplevel window.
font_imp: fti::Font_Imp,
atom_imp: ai::Atom_Imp,
window_property_imp: wpi::Window_Property_Imp,
selection_imp: si::Selection_Imp,
keymap_imp: ki::Keymap_Imp
};
Screen = { # A screen handle for users.
xsession: Xsession,
screen_info: Screen_Info
};
# An on-screen pixmap:
#
Window
=
# WINDOW
{
window_id: xt::Window_Id,
#
screen: Screen,
per_depth_imps: Per_Depth_Imps,
#
to_hostwindow_drawimp: di::d::Draw_Op -> Void
};
# Identity tests:
#
fun same_xsession
( { xdisplay=>{ xsocket => x1, ... }: dy::Xdisplay, ... }: Xsession,
{ xdisplay=>{ xsocket => x2, ... }: dy::Xdisplay, ... }: Xsession
)
=
xok::same_xsocket (x1, x2);
#
fun same_screen ( { xsession=>xsession1, screen_info=> { xscreen => { id=>id1, ... }: dy::Xscreen, ... }: Screen_Info}: Screen,
{ xsession=>xsession2, screen_info=> { xscreen => { id=>id2, ... }: dy::Xscreen, ... }: Screen_Info}: Screen
)
=
(id1 == id2)
and
same_xsession (xsession1, xsession2);
#
fun same_window ( { window_id=>id1, screen=>s1, ... }: Window,
{ window_id=>id2, screen=>s2, ... }: Window
)
=
(id1 == id2) and same_screen (s1, s2);
# See overview comments in
#
# src/lib/x-kit/xclient/src/window/xsession-old.api #
fun open_xsession # Called mainly from make_root_window in src/lib/x-kit/widget/old/basic/root-window-old.pkg ( display_name: String,
xauthentication: Null_Or( xt::Xauthentication ) # Xauthentication info comes ultimately from ~/.Xauthority
)
=
{ # We turn this off in close_xession, so for symmetry's
# sake we turn it on here in open_xsession:
# # tracing is from src/lib/src/lib/thread-kit/src/lib/logger.pkg logger::disable thread_deathwatch::logging; # thread_deathwatch is from src/lib/src/lib/thread-kit/src/lib/thread-deathwatch.pkg (dy::open_xdisplay { display_name, xauthentication })
->
(xdisplay as { default_screen, screens, xsocket, next_xid, ... }: dy::Xdisplay );
keymap_imp = ki::make_keymap_imp xdisplay;
atom_imp = ai::make_atom_imp xdisplay;
(wpi::make_window_property_imp (xdisplay, atom_imp))
->
(to_window_property_imp_slot, window_property_imp);
(si::make_selection_imp xdisplay)
->
(to_selection_imp_slot, selection_imp);
xsocket_to_hostwindow_router
=
s2t::make_xsocket_to_hostwindow_router
{ xdisplay,
keymap_imp,
#
to_window_property_imp_slot,
to_selection_imp_slot
};
#
fun make_screen_info (xscreen as { root_window_id, root_visual, visuals, ... }: dy::Xscreen )
=
{ fun make_per_depth_imps (depth, pen_imp)
=
{ drawimp_mappedstate_slot = make_mailslot ();
make_thread "send FIRST_EXPOSE" {. put_in_mailslot (drawimp_mappedstate_slot, di::s::FIRST_EXPOSE); };
trace {. "XYZZY xsession: open_xsession: make_screen_info: make_per_depth_imps: Making Per_Depth_Iimps record"; };
{
depth,
pen_imp,
to_screen_drawimp
=>
di::make_draw_imp
( take_from_mailslot' drawimp_mappedstate_slot,
pen_imp,
xsocket
)
}: Per_Depth_Imps ;
};
#
fun make_pen_imps ([], l)
=>
l;
make_pen_imps (vd ! r, l)
=>
{
visual_depth = dy::depth_of_visual vd;
trace {. sprintf "XYZZY xsession: open_xsession: make_pen_imps: visual_depth d=%d Making root_imps" visual_depth; };
#
fun make_imps ()
=
{ pixmap_id = next_xid ();
# Make a pixmap to serve as the
# witness drawable for the GC server:
#
xok::send_xrequest xsocket
( value_to_wire::encode_create_pixmap
{ pixmap_id,
drawable_id => root_window_id,
size => { wide=>1, high=>1 },
depth => visual_depth
}
);
make_per_depth_imps
(visual_depth, p2g::make_pen_to_gcontext_imp (xdisplay, pixmap_id));
};
#
fun get []
=>
make_imps() ! l;
get (({ depth, ... }: Per_Depth_Imps) ! rest)
=>
depth == visual_depth
?? l
:: get rest;
end;
make_pen_imps (r, get l);
};
end;
trace {. "XYZZY xsession: open_xsession: Making root_imps"; };
rootwindow_per_depth_imps
=
make_per_depth_imps
(
dy::depth_of_visual root_visual,
p2g::make_pen_to_gcontext_imp (xdisplay, root_window_id)
);
trace {. "XYZZY xsession: open_xsession: Making per-visual imps"; };
per_depth_imps
=
make_pen_imps (visuals, [ rootwindow_per_depth_imps ]);
trace {. "XYZZY xsession: open_xsession: Making NO_VISUAL_FOR_THIS_DEPTH 1 imp-pair"; };
per_depth_imps
=
make_pen_imps ( [ xt::NO_VISUAL_FOR_THIS_DEPTH 1 ],
per_depth_imps
);
trace {. "XYZZY xsession: open_xsession: building and returning SCREEN_INFO record"; };
{
xscreen,
per_depth_imps,
rootwindow_per_depth_imps
}
: Screen_Info
;
};
screens = map make_screen_info screens;
{ xdisplay,
default_screen_info => list::nth (screens, default_screen),
screens,
xsocket_to_hostwindow_router,
atom_imp,
font_imp => fti::make_font_imp xdisplay,
window_property_imp,
selection_imp,
keymap_imp
}
: Xsession
;
}; # fun open_xsession
# X-server I/O.
#
stipulate
#
fun apply_to_xsocket f ({ xdisplay=>{ xsocket, ... }: dy::Xdisplay, ... }: Xsession)
=
f xsocket;
herein
send_xrequest = apply_to_xsocket xok::send_xrequest;
send_xrequest_and_return_completion_mailop = apply_to_xsocket xok::send_xrequest_and_return_completion_mailop;
send_xrequest_and_read_reply = apply_to_xsocket xok::send_xrequest_and_read_reply;
sent_xrequest_and_read_replies = apply_to_xsocket xok::sent_xrequest_and_read_replies;
flush_out = apply_to_xsocket xok::flush_xsocket;
query_best_size = apply_to_xsocket xok::query_best_size;
query_colors = apply_to_xsocket xok::query_colors;
query_font = apply_to_xsocket xok::query_font;
query_pointer = apply_to_xsocket xok::query_pointer;
query_text_extents = apply_to_xsocket xok::query_text_extents;
query_tree = apply_to_xsocket xok::query_tree;
end;
# Get location of mouse pointer
# plus related information:
#
fun get_mouse_location
( { xdisplay => { xsocket, ... }: dy::Xdisplay,
default_screen_info => { xscreen => { root_window_id, ... }: dy::Xscreen, ... }: Screen_Info,
...
}: Xsession
)
=
{ # The X server query_pointer call takes a window_id
# argument. This seems overcomplex for the typical
# Mythryl caller, so here we just default it to the
# the default-screen root-window:
#
(xok::query_pointer xsocket { window_id => root_window_id })
->
{ root_point, ... };
# The X server query_pointer call returns
# a load of stuff. For now at least, a
# return value of simply the mouse location
# seems more convenient for the Mythryl app hacker:
#
root_point;
};
#
fun set_mouse_location
(
{ xdisplay => { xsocket, ... }: dy::Xdisplay,
default_screen_info => { xscreen => { root_window_id, ... }: dy::Xscreen, ... }: Screen_Info,
...
}: Xsession
)
to_point
=
{ # This is an ignored dummy value:
#
from_box = { col => 0, row => 0, wide => 0, high => 0 };
command
=
v2w::encode_warp_pointer
{
to_point, # Move mouse pointer to this coordinate.
to => THE root_window_id, # Position mouse relative to root window.
# # (That is, in absolute screen coordinates.)
from => NULL,
from_box # Ignored because 'from' is NULL.
};
xok::send_xrequest xsocket command;
};
# Map a point in the window's coordinate
# system to the screen's coordinate system:
#
fun window_point_to_screen_point ({ window_id, screen, ... }: Window) pt
=
{ screen -> { xsession, screen_info => { xscreen => { root_window_id, ... }: dy::Xscreen, ... }: Screen_Info, ... }: Screen;
#
my { to_point, ... }
=
w2v::decode_translate_coordinates_reply
(
block_until_mailop_fires
(send_xrequest_and_read_reply
xsession
(v2w::encode_translate_coordinates { from_window=>window_id, to_window=>root_window_id, from_point=>pt } )
)
);
to_point;
};
# Fake up an X server timestamp for the current time
# by taking the time of day in milliseconds to 32-bit
# accuracy and then jiggering the type appropriately:
#
fun bogus_current_x_timestamp ()
=
{ time = time::get_current_time_utc (); # Current time
ms = time::to_milliseconds time; # in milliseconds since the Epoch
ms32 = large_int::(%) (ms, (large_int::from_int 256)*(large_int::from_int 256)*(large_int::from_int 256)*(large_int::from_int 256)); # truncated to 32-bit accuracy
ms32 = one_word_unt::from_multiword_int ms32; # converted to 32-bit unsigned
ms32 = xserver_timestamp::XSERVER_TIMESTAMP ms32; # wrapped up as a
ms32 = xtypes::TIMESTAMP ms32; # proper X timestamp value.
ms32;
};
#
fun send_fake_key_press_xevent
(
{ xdisplay => { xsocket, ... }: dy::Xdisplay,
default_screen_info => { xscreen => { root_window_id, ... }: dy::Xscreen, ... }: Screen_Info,
...
}: Xsession
)
{ window => window as { window_id, ... }: Window, # Window handling the keyboard-key press event.
keycode, # Keyboard key just "pressed".
point => point as { row, col } # Keypress location in local window coordinates.
}
=
{ # We need the keypress point in both
# local and screen coords:
#
trace {. sprintf "xsession: send_fake_key_press_event/TOP window_point = { row %d, col %d }." row col; };
(window_point_to_screen_point window point)
->
{ row => screen_row,
col => screen_col
};
trace {. sprintf "xsession: send_fake_key_press_event/MID screen_point = { row %d, col %d }." screen_row screen_col; };
# For the semantics of these three fields see
# p27 http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
send_event_to = xt::SEND_EVENT_TO_WINDOW window_id;
propagate = FALSE;
event_mask = xt::EVENT_MASK 0u0;
#
# timestamp = xt::CURRENT_TIME; # I had thought the X server would fill this in for us, but apparently it passes it through. :-(
timestamp = bogus_current_x_timestamp (); # This won't sync with real X server timestamps, but I don't see a simple way to make it do so.
# Currently we never mix synthetic and natural X events, but this is a bug waiting to happen. XXX BUGGO FIXME.
root_window_id = root_window_id;
event_window_id = window_id; # Window handling the keyboard-key "press" event.
child_window_id = NULL; # We'll assume specified window is a leaf.
root_x = screen_col; # Mouse position on root window at time of keypress.
root_y = screen_row;
event_x = col; # Mouse position on recipient window at time of keypress.
event_y = row;
buttons = kab::make_mousebutton_state [ ]; # Mouse buttons state BEFORE keypress.
trace {. "xsession: send_fake_key_press_event/YYY calling s2w::encode_send_keypress_xevent"; };
command
=
s2w::encode_send_keypress_xevent
{
send_event_to, propagate, event_mask,
timestamp, root_window_id, event_window_id, child_window_id, root_x, root_y, event_x, event_y, keycode, buttons
};
xok::send_xrequest xsocket command;
trace {. "xsession: send_fake_key_press_event/BOT called s2w::encode_send_keypress_xevent -- DONE"; };
();
};
#
fun send_fake_key_release_xevent
(
{ xdisplay => { xsocket, ... }: dy::Xdisplay,
default_screen_info => { xscreen => { root_window_id, ... }: dy::Xscreen, ... }: Screen_Info,
...
}: Xsession
)
{ window => window as { window_id, ... }: Window, # Window handling the keyboard-key release event.
keycode, # Keyboard key just "released".
point => point as { row, col } # Key release location in local window coordinates.
}
=
{ # We need the key release point in both
# local and screen coords:
#
trace {. sprintf "xsession: send_fake_key_release_event/TOP window_point = { row %d, col %d }." row col; };
(window_point_to_screen_point window point)
->
{ row => screen_row,
col => screen_col
};
trace {. sprintf "xsession: send_fake_key_release_event/MID screen_point = { row %d, col %d }." screen_row screen_col; };
# For the semantics of these three fields see
# p27 http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
send_event_to = xt::SEND_EVENT_TO_WINDOW window_id;
propagate = FALSE;
event_mask = xt::EVENT_MASK 0u0;
#
# timestamp = xt::CURRENT_TIME; # I had thought the X server would fill this in for us, but apparently it passes it through. :-(
timestamp = bogus_current_x_timestamp (); # This won't sync with real X server timestamps, but I don't see a simple way to make it do so.
# Currently we never mix synthetic and natural X events, but this is a bug waiting to happen. XXX BUGGO FIXME.
root_window_id = root_window_id;
event_window_id = window_id; # Window handling the keyboard-key "release" event.
child_window_id = NULL; # We'll assume specified window is a leaf.
root_x = screen_col; # Mouse position on root window at time of key "release".
root_y = screen_row;
event_x = col; # Mouse position on recipient window at time of key "release".
event_y = row;
buttons = kab::make_mousebutton_state [ ]; # Mouse buttons state BEFORE key release.
trace {. "xsession: send_fake_key_release_event/YYY calling s2w::encode_send_keyrelease_xevent"; };
command
=
s2w::encode_send_keyrelease_xevent
{
send_event_to, propagate, event_mask,
timestamp, root_window_id, event_window_id, child_window_id, root_x, root_y, event_x, event_y, keycode, buttons
};
xok::send_xrequest xsocket command;
trace {. "xsession: send_fake_key_release_event/BOT called s2w::encode_send_keyrelease_xevent -- DONE"; };
();
};
#
fun send_fake_mousebutton_press_xevent
(
{ xdisplay => { xsocket, ... }: dy::Xdisplay,
default_screen_info => { xscreen => { root_window_id, ... }: dy::Xscreen, ... }: Screen_Info,
...
}: Xsession
)
{ window => window as { window_id, ... }: Window, # Window handling the mouse-button click event.
button, # Mouse button just "clicked" down.
point => point as { row, col } # Click location in local window coordinates.
}
=
{ # We need the clickpoint in both
# local and screen coords:
#
trace {. sprintf "xsession: send_fake_mousebutton_press_event/TOP window_point = { row %d, col %d }." row col; };
(window_point_to_screen_point window point)
->
{ row => screen_row,
col => screen_col
};
trace {. sprintf "xsession: send_fake_mousebutton_press_event/MID screen_point = { row %d, col %d }." screen_row screen_col; };
# For the semantics of these three fields see
# p27 http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
send_event_to = xt::SEND_EVENT_TO_WINDOW window_id;
propagate = FALSE;
event_mask = xt::EVENT_MASK 0u0;
#
# timestamp = xt::CURRENT_TIME; # I had thought the X server would fill this in for us, but apparently it passes it through. :-(
timestamp = bogus_current_x_timestamp (); # This won't sync with real X server timestamps, but I don't see a simple way to make it do so.
# Currently we never mix synthetic and natural X events, but this is a bug waiting to happen. XXX BUGGO FIXME.
root_window_id = root_window_id;
event_window_id = window_id; # Window handling the mouse-button release event.
child_window_id = NULL; # We'll assume specified window is a leaf.
root_x = screen_col; # Mouse position on root window at time of button release.
root_y = screen_row;
event_x = col; # Mouse position on recipient window at time of button release.
event_y = row;
buttons = kab::make_mousebutton_state [ ]; # Mouse buttons state BEFORE button press.
trace {. "xsession: send_fake_mousebutton_press_event/YYY calling s2w::encode_send_buttonpress_xevent"; };
command = s2w::encode_send_buttonpress_xevent
{
send_event_to, propagate, event_mask,
timestamp, root_window_id, event_window_id, child_window_id, root_x, root_y, event_x, event_y, button, buttons
};
xok::send_xrequest xsocket command;
trace {. "xsession: send_fake_mousebutton_press_event/BOT called s2w::encode_send_buttonpress_xevent -- DONE"; };
();
};
#
fun send_fake_mousebutton_release_xevent
(
{ xdisplay => { xsocket, ... }: dy::Xdisplay,
default_screen_info => { xscreen => { root_window_id, ... }: dy::Xscreen, ... }: Screen_Info,
...
}: Xsession
)
{ window => window as { window_id, ... }: Window, # Window handling the mouse-button click event.
button, # Mouse button just "clicked" down.
point => point as { row, col } # Click location in local window coordinates.
}
=
{ # We need the clickpoint in both
# local and screen coords:
#
trace {. sprintf "xsession: send_fake_mousebutton_release_xevent/TOP window_point = { row %d, col %d }." row col; };
(window_point_to_screen_point window point)
->
{ row => screen_row,
col => screen_col
};
trace {. sprintf "xsession: send_fake_mousebutton_release_xevent/MID screen_point = { row %d, col %d }." screen_row screen_col; };
# For the semantics of these three fields see
# p27 http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
send_event_to = xt::SEND_EVENT_TO_WINDOW window_id;
propagate = FALSE;
event_mask = xt::EVENT_MASK 0u0;
#
# timestamp = xt::CURRENT_TIME; # I had thought the X server would fill this in for us, but apparently it passes it through. :-(
timestamp = bogus_current_x_timestamp (); # This won't sync with real X server timestamps, but I don't see a simple way to make it do so.
# Currently we never mix synthetic and natural X events, but this is a bug waiting to happen. XXX BUGGO FIXME.
root_window_id = root_window_id;
event_window_id = window_id; # Window handling the mouse-button release event.
child_window_id = NULL; # We'll assume specified window is a leaf.
root_x = screen_col; # Mouse position on root window at time of button release.
root_y = screen_row;
event_x = col; # Mouse position on recipient window at time of button release.
event_y = row;
buttons = kab::make_mousebutton_state [ button ]; # Mouse buttons state BEFORE button release.
trace {. "xsession: send_fake_mousebutton_release_xevent/YYY calling s2w::encode_send_buttonpress_xevent"; };
command = s2w::encode_send_buttonrelease_xevent
{
send_event_to, propagate, event_mask,
timestamp, root_window_id, event_window_id, child_window_id, root_x, root_y, event_x, event_y, button, buttons
};
xok::send_xrequest xsocket command;
trace {. "xsession: send_fake_mousebutton_release_event/BOT called s2w::encode_send_buttonpress_xevent -- DONE"; };
();
};
#
fun send_fake_mouse_motion_xevent
(
{ xdisplay => { xsocket, ... }: dy::Xdisplay,
default_screen_info => { xscreen => { root_window_id, ... }: dy::Xscreen, ... }: Screen_Info,
...
}: Xsession
)
{ window => window as { window_id, ... }: Window, # Window handling the mouse-moution event.
buttons, # Mouse button(s) being dragged.
point => point as { row, col } # Motion location in local window coordinates.
}
=
{ # We need the clickpoint in both
# local and screen coords:
#
trace {. sprintf "xsession: send_fake_mouse_motion_xevent/TOP window_point = { row %d, col %d }." row col; };
(window_point_to_screen_point window point)
->
{ row => screen_row,
col => screen_col
};
trace {. sprintf "xsession: send_fake_mouse_motion_xevent/MID screen_point = { row %d, col %d }." screen_row screen_col; };
# For the semantics of these three fields see
# p27 http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
send_event_to = xt::SEND_EVENT_TO_WINDOW window_id;
propagate = FALSE;
event_mask = xt::EVENT_MASK 0u0;
#
# timestamp = xt::CURRENT_TIME; # I had thought the X server would fill this in for us, but apparently it passes it through. :-(
timestamp = bogus_current_x_timestamp (); # This won't sync with real X server timestamps, but I don't see a simple way to make it do so.
# Currently we never mix synthetic and natural X events, but this is a bug waiting to happen. XXX BUGGO FIXME.
root_window_id = root_window_id;
event_window_id = window_id; # Window handling the mouse-button release event.
child_window_id = NULL; # We'll assume specified window is a leaf.
root_x = screen_col; # Mouse position on root window at time of button release.
root_y = screen_row;
event_x = col; # Mouse position on recipient window at time of button release.
event_y = row;
buttons = kab::make_mousebutton_state buttons; # Mouse buttons being dragged
trace {. "xsession: send_fake_mouse_motion_xevent/YYY calling s2w::encode_send_motionnotify_xevent"; };
command = s2w::encode_send_motionnotify_xevent
{
send_event_to, propagate, event_mask,
timestamp, root_window_id, event_window_id, child_window_id, root_x, root_y, event_x, event_y, buttons
};
xok::send_xrequest xsocket command;
trace {. "xsession: send_fake_mouse_motion_event/BOT called s2w::encode_send_motionnotify_xevent -- DONE"; };
();
};
#
fun send_fake_''mouse_enter''_xevent
(
{ xdisplay => { xsocket, ... }: dy::Xdisplay,
default_screen_info => { xscreen => { root_window_id, ... }: dy::Xscreen, ... }: Screen_Info,
...
}: Xsession
)
{ window => window as { window_id, ... }: Window, # Window handling the mouse-button click event.
point => point as { row, col } # Click location in local window coordinates.
}
=
{ # We need the point in both
# local and screen coords:
#
trace {. sprintf "xsession: send_fake_''mouse_enter''_xevent/TOP window_point = { row %d, col %d }." row col; };
(window_point_to_screen_point window point)
->
{ row => screen_row,
col => screen_col
};
trace {. sprintf "xsession: send_fake_''mouse_enter''_xevent/MID screen_point = { row %d, col %d }." screen_row screen_col; };
# For the semantics of these three fields see
# p27 http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
send_event_to = xt::SEND_EVENT_TO_WINDOW window_id;
propagate = FALSE;
event_mask = xt::EVENT_MASK 0u0;
#
# timestamp = xt::CURRENT_TIME; # I had thought the X server would fill this in for us, but apparently it passes it through. :-(
timestamp = bogus_current_x_timestamp (); # This won't sync with real X server timestamps, but I don't see a simple way to make it do so.
# Currently we never mix synthetic and natural X events, but this is a bug waiting to happen. XXX BUGGO FIXME.
root_window_id = root_window_id;
event_window_id = window_id; # Window handling the mouse-button release event.
child_window_id = NULL; # We'll assume specified window is a leaf.
root_x = screen_col; # Mouse position on root window at time of button release.
root_y = screen_row;
event_x = col; # Mouse position on recipient window at time of button release.
event_y = row;
buttons = xt::MOUSEBUTTON_STATE 0u0;
trace {. "xsession: send_fake_''mouse_enter''_xevent/YYY calling s2w::encode_send_enternotify_xevent"; };
command = s2w::encode_send_enternotify_xevent
{
send_event_to, propagate, event_mask,
timestamp, root_window_id, event_window_id, child_window_id, root_x, root_y, event_x, event_y, buttons
};
xok::send_xrequest xsocket command;
trace {. "xsession: send_fake_''mouse_enter''_xevent/BOT called s2w::encode_send_enternotify_xevent -- DONE"; };
();
};
fun send_fake_''mouse_leave''_xevent
(
{ xdisplay => { xsocket, ... }: dy::Xdisplay,
default_screen_info => { xscreen => { root_window_id, ... }: dy::Xscreen, ... }: Screen_Info,
...
}: Xsession
)
{ window => window as { window_id, ... }: Window, # Window handling the mouse-button click event.
point => point as { row, col } # Click location in local window coordinates.
}
=
{ # We need the point in both
# local and screen coords:
#
trace {. sprintf "xsession: send_fake_''mouse_leave''_xevent/TOP window_point = { row %d, col %d }." row col; };
(window_point_to_screen_point window point)
->
{ row => screen_row,
col => screen_col
};
trace {. sprintf "xsession: send_fake_''mouse_leave''_xevent/MID screen_point = { row %d, col %d }." screen_row screen_col; };
# For the semantics of these three fields see
# p27 http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
send_event_to = xt::SEND_EVENT_TO_WINDOW window_id;
propagate = FALSE;
event_mask = xt::EVENT_MASK 0u0;
#
# timestamp = xt::CURRENT_TIME; # I had thought the X server would fill this in for us, but apparently it passes it through. :-(
timestamp = bogus_current_x_timestamp (); # This won't sync with real X server timestamps, but I don't see a simple way to make it do so.
# Currently we never mix synthetic and natural X events, but this is a bug waiting to happen. XXX BUGGO FIXME.
root_window_id = root_window_id;
event_window_id = window_id; # Window handling the mouse-button release event.
child_window_id = NULL; # We'll assume specified window is a leaf.
root_x = screen_col; # Mouse position on root window at time of button release.
root_y = screen_row;
event_x = col; # Mouse position on recipient window at time of button release.
event_y = row;
buttons = xt::MOUSEBUTTON_STATE 0u0;
trace {. "xsession: send_fake_''mouse_leave''_xevent/YYY calling s2w::encode_send_leavenotify_xevent"; };
command = s2w::encode_send_leavenotify_xevent
{
send_event_to, propagate, event_mask,
timestamp, root_window_id, event_window_id, child_window_id, root_x, root_y, event_x, event_y, buttons
};
xok::send_xrequest xsocket command;
trace {. "xsession: send_fake_''mouse_leave''_xevent/BOT called s2w::encode_send_leavenotify_xevent -- DONE"; };
();
};
# Close the xsession.
# NOTE: there are probably other things
# that should go on here, such as notifying
# the xbuf_to_hostwindow_xevent_router. XXX BUGGO FIXME
#
fun close_xsession ({ xdisplay, ... }: Xsession)
=
{ # Threads will die left and right as we shut down,
# and scary warning messages will by default be
# logged to stdout, so suppress that to avoid
# spooking the user:
#
logger::disable thread_deathwatch::logging;
dy::close_xdisplay xdisplay;
};
# Return the maximum request size
# supported by the display:
#
fun max_request_length ({ xdisplay=>{ max_request_length, ... }: dy::Xdisplay, ... }: Xsession)
=
max_request_length;
# Atom operations:
#
stipulate
#
fun wrap_atom_op f ({ atom_imp, ... }: Xsession)
=
f atom_imp;
herein
#
make_atom = wrap_atom_op ai::make_atom;
find_atom = wrap_atom_op ai::find_atom;
atom_to_string = wrap_atom_op ai::atom_to_string;
end;
# Font operations:
#
fun find_else_open_font ({ font_imp, ... }: Xsession) # This is a misnomer, this version always opens it via round-trip to X server. But this is old code due to be discarded.
=
fti::open_a_font font_imp;
#
fun default_screen_of (xsession as { default_screen_info, ... }: Xsession)
=
{ xsession, screen_info => default_screen_info }: Screen;
#
fun get_''gui_startup_complete''_oneshot_of_xsession (xsession as { xsocket_to_hostwindow_router, ... }: Xsession)
=
s2t::get_''gui_startup_complete''_oneshot_of
#
xsocket_to_hostwindow_router;
#
fun screens_of (xsession as { screens, ... }: Xsession)
=
map (\\ s = { xsession, screen_info => s }: Screen)
screens;
#
fun ring_bell xsession percent
=
send_xrequest xsession
(value_to_wire::encode_bell { percent => int::min (100, int::max(-100, percent)) } );
# Screen functions:
#
color_of_screen
=
cs::get_color;
#
fun xsession_of_screen ({ xsession, ... }: Screen )
=
xsession;
# Additions by ddeboer, May 2004.
# Dusty deBoer, KSU CIS 705, Spring 2004.
# Return the root window of a screen.
# This is needed in obtaining strings from xrdb,
# as they are stored in a property of the root window:
#
fun root_window_of_screen ({ screen_info => { xscreen => { root_window_id, ... }: dy::Xscreen, ... }: Screen_Info, ... }: Screen )
=
root_window_id;
# End additions by ddeboer
#
fun size_of_screen ({ screen_info => { xscreen => { size_in_pixels, ... }: dy::Xscreen, ... }: Screen_Info, ... }: Screen )
=
size_in_pixels;
#
fun mm_size_of_screen ({ screen_info => { xscreen => { size_in_mm, ... }: dy::Xscreen, ... }: Screen_Info, ... }: Screen )
=
size_in_mm;
#
fun depth_of_screen ({ screen_info => { xscreen => { root_visual, ... }: dy::Xscreen, ... }: Screen_Info, ... }: Screen )
=
dy::depth_of_visual root_visual;
#
fun display_class_of_screen ({ screen_info => { xscreen => { root_visual, ... }: dy::Xscreen, ... }: Screen_Info, ... }: Screen )
=
case (dy::display_class_of_visual root_visual)
THE c => c;
_ => xgripe::impossible "[xsession::display_class_of_screen: bogus root visual]";
esac;
# Return the pen-to-gcontext and draw imps
# for given depth on given screen:
#
fun per_depth_imps_for_depth ({ screen_info => { per_depth_imps, ... }: Screen_Info, ... }: Screen, given_depth)
=
search per_depth_imps
where
fun search []
=>
xgripe::xerror "invalid depth for screen";
search ((sd as { depth, ... }: Per_Depth_Imps) ! rest)
=>
if (depth == given_depth) sd;
else search rest;
fi;
end;
end;
#
fun keysym_to_keycode ({ keymap_imp, ... }: Xsession, keysym)
=
ki::keysym_to_keycode (keymap_imp, keysym);
}; # package xsession
end; # stipulate.