## root-window.pkg
#
# This widget represents the root window on an X screen
# -- the one on which the wallpaper is drawn. X stores
# various things like the X resource database as properties
# on the root window.
# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublib### "Deep in their roots, all flowers keep the light."
###
### -- Theodore Roethke
# See also:
#
# src/lib/x-kit/widget/old/basic/root-window-old.apistipulate
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 xc = xclient; # xclient is from src/lib/x-kit/xclient/xclient.pkg package ii = image_ximp; # image_ximp is from src/lib/x-kit/widget/lib/image-ximp.pkg# package ip = client_to_image; # client_to_image is from src/lib/x-kit/widget/lib/client-to-image.pkg package pxc = ro_pixmap_ximp; # ro_pixmap_ximp is from src/lib/x-kit/widget/lib/ro-pixmap-ximp.pkg package rpp = ro_pixmap_port; # ro_pixmap_port is from src/lib/x-kit/widget/lib/ro-pixmap-port.pkg package si = shade_ximp; # shade _ximp is from src/lib/x-kit/widget/lib/shade-ximp.pkg package shp = shade; # shade is from src/lib/x-kit/widget/lib/shade.pkg package wa = widget_attribute; # widget_attribute is from src/lib/x-kit/widget/lib/widget-attribute.pkg package wy = widget_style; # widget_style is from src/lib/x-kit/widget/lib/widget-style.pkg package xrs = cursors; # cursors is from src/lib/x-kit/xclient/src/window/cursors.pkg package rop = ro_pixmap; # ro_pixmap is from src/lib/x-kit/xclient/src/window/ro-pixmap.pkg package cpm = cs_pixmap; # cs_pixmap is from src/lib/x-kit/xclient/src/window/cs-pixmap.pkg package rgb = rgb; # rgb is from src/lib/x-kit/xclient/src/color/rgb.pkg package wp = window_property; # window_property is from src/lib/x-kit/xclient/src/iccc/window-property.pkg package xj = xsession_junk; # xsession_junk is from src/lib/x-kit/xclient/src/window/xsession-junk.pkgherein
package root_window # Why is this not ": Root_Window" ??? XXX BUGGO FIXME
# Root_Window is from src/lib/x-kit/widget/lib/root-window.api #
# 2013-08-18: I think Reppy's idea was to have datastructures like
# Root_Window be transparent within xclient.lib but
# opaque to widget packets etc, and that he was aiming
# to achieve this by keeping the package unsealed internally
# but sealing it before exporting it to the widget level.
{
# Root chunk, corresponding to display/screen pair.
# server = "" => "unix:0.0"
# = ":d" => "unix:d.0"
# = "host:d" => "host:d.0"
# = "host:d.s" => "host:d.s"
# where host is an internet address (e.g., "128.84.254.97") or "unix".
#
# At present, screen is always the default screen.
# (In practice modern displays have only the
# default screen -- even multiple-monitor ones.)
Root_Window
=
{ id: Id, # This is for internal client-side use only -- never gets passed to X.
#
screen: xj::Screen,
#
make_shade: rgb::Rgb -> shp::Shades,
make_tile: String -> rop::Ro_Pixmap,
#
style: wy::Widget_Style,
next_widget_id: Void -> Int
};
init_images
=
[ (quark::quark "lightGray", standard_clientside_pixmaps::light_gray),
(quark::quark "gray", standard_clientside_pixmaps::gray )
];
fun make_root_window # Called (mainly) from make_root_window in src/lib/x-kit/widget/lib/run-in-x-window.pkg { # also from src/lib/x-kit/xclient/src/stuff/xclient-unit-test.pkg display_name: String, # Typically from DISPLAY environment variable.
xauthentication: Null_Or( xt::Xauthentication ), # Ultimately from ~/.Xauthority.
run_gun': Run_Gun,
end_gun': End_Gun
}
=
{
xsession = xj::open_xsession { display_name, xauthentication, run_gun', end_gun' };
#
screen = xj::default_screen_of xsession;
#
widget_id_slot = make_mailslot ();
fun widget_id_loop i
=
{ put_in_mailslot (widget_id_slot, i);
#
widget_id_loop (i+1);
};
( ii::make_image_egg [] ) -> image_egg; # Create the (encapsulated) state records for our imps.
(pxc::make_ro_pixmap_egg (screen, [])) -> ro_pixmap_egg;
( si::make_shade_egg (screen, [])) -> shade_egg;
( image_egg ()) -> ( image_exports, image_egg'); # Start up the imp microthreads and get their Exports.
(ro_pixmap_egg ()) -> (ro_pixmap_exports, ro_pixmap_egg');
( shade_egg ()) -> ( shade_exports, shade_egg');
client_to_image = image_exports.client_to_image;
ro_pixmap_port = ro_pixmap_exports.ro_pixmap_port;
shade = shade_exports.shade;
ro_pixmap_egg' ({ name_to_cs_pixmap => client_to_image.get_image }, run_gun', end_gun'); # Hand the imp microthreads their Imports.
image_egg' ({ }, run_gun', end_gun');
shade_egg' ({ }, run_gun', end_gun');
# fire_run_gun ();
fun make_tile name
=
case (ro_pixmap_port.get_ro_pixmap name)
#
THE tile => tile;
NULL => { msg = (sprintf "make_tile: failed to find tile '%s' -- root-window.pkg" name);
log::fatal msg;
raise exception DIE msg;
};
esac;
fun make_shade rgb
=
case (shade.get_shades rgb)
#
THE shades => shades;
#
NULL => { msg = "make_shade: failed to create shades -- root-window.pkg";
log::fatal msg;
raise exception DIE msg;
};
esac;
make_thread "widget_id factory" {. widget_id_loop 0; };
{ id => issue_unique_id(),
screen,
style => wy::empty_style { screen, tilef => make_tile },
make_tile,
make_shade,
next_widget_id => \\ () = take_from_mailslot widget_id_slot # Gets used (only) in widget::make_widget, in src/lib/x-kit/widget/old/basic/widget.pkg }
: Root_Window
;
};
fun screen_of ({ screen, ... }: Root_Window) = screen;
fun xsession_of ({ screen, ... }: Root_Window ) = xj::xsession_of_screen screen;
fun delete_root_window root
=
xj::close_xsession (xsession_of root);
fun same_root ({ id, ... }: Root_Window, { id=>id', ... }: Root_Window )
=
id_to_int id ==
id_to_int id' ;
fun shades ({ make_shade, ... }: Root_Window ) c = make_shade c;
fun ro_pixmap ({ make_tile, ... }: Root_Window ) s = make_tile s;
fun color_of
({ screen, ... }: Root_Window )
color_spec
=
xc::get_color color_spec;
fun open_font ({ screen, ... }: Root_Window )
=
xj::find_font (xj::xsession_of_screen screen);
fun get_standard_xcursor ({ screen, ... }: Root_Window ) = xrs::get_standard_xcursor (xj::xsession_of_screen screen);
fun ring_bell ({ screen, ... }: Root_Window ) = xj::ring_bell (xj::xsession_of_screen screen);
fun size_of_screen ({ screen, ... }: Root_Window ) = xj::size_of_screen screen;
fun mm_size_of_screen ({ screen, ... }: Root_Window ) = xj::mm_size_of_screen screen;
fun depth_of_screen ({ screen, ... }: Root_Window ) = xj::depth_of_screen screen;
fun style_of ({ style, ... }: Root_Window ) = style;
fun is_monochrome ({ screen, ... }: Root_Window )
=
xj::display_class_of_screen screen == xt::STATIC_GRAY and
xj::depth_of_screen screen == 1;
fun style_from_strings ({ screen, make_tile, ... }: Root_Window, sl)
=
wy::style_from_strings ( { screen, tilef=>make_tile }, sl);
fun strings_from_style sty = wy::strings_from_style sty;
fun merge_styles (sty1, sty2) = wy::merge_styles (sty1, sty2);
fun style_from_xrdb root
=
{ xsession = xsession_of root;
screen = xj::default_screen_of xsession;
stl = wp::xrdb_of_screen screen;
# (file::print ("XRDB strings:\n"$(string::join "\n" stl)$"\n"));
style_from_strings (root, stl);
};
Opt_Name = wy::Opt_Name;
Arg_Name = wy::Arg_Name;
Opt_Kind = wy::Opt_Kind;
Opt_Spec = wy::Opt_Spec;
Opt_Db = wy::Opt_Db;
# widget_attribute is from src/lib/x-kit/widget/lib/widget-attribute.pkg Value = wa::Value;
fun parse_command (o_spec) sl
=
wy::parse_command (o_spec) sl;
fun find_named_opt (o_db: wy::Opt_Db) (o_nam: wy::Opt_Name) ({ screen, make_tile, ... }: Root_Window )
=
wy::find_named_opt o_db o_nam { screen, tilef=>make_tile };
fun style_from_opt_db ({ screen, make_tile, ... }: Root_Window, o_db)
=
wy::style_from_opt_db ( { screen, tilef=>make_tile }, o_db);
fun find_named_opt_strings (o_db: wy::Opt_Db) (o_nam: wy::Opt_Name)
=
wy::find_named_opt_strings o_db o_nam;
fun help_string_from_opt_spec (o_spec)
=
wy::help_string_from_opt_spec o_spec;
}; # package root_window
end;