## 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/basic/root-window.apistipulate
include threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package xc = xclient; # xclient is from src/lib/x-kit/xclient/xclient.pkg package ii = image_imp; # image_imp is from src/lib/x-kit/widget/lib/image-imp.pkg package pxc = ro_pixmap_cache; # ro_pixmap_cache is from src/lib/x-kit/widget/lib/ro-pixmap-cache.pkg package si = shade_imp; # shade_imp is from src/lib/x-kit/widget/lib/shade-imp.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.pkgherein
package root_window { # Why is this not ": Root_Window" ??? XXX BUGGO FIXME
# 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.
Style = wy::Style;
Root_Window
=
ROOT_WINDOW
{ screen: xc::Screen,
id: Ref( Void ), # Here we are just taking advantage of
# # the fact that all REFs are distinct.
mkshade: xc::Rgb -> si::Shades,
mktile: String -> xc::Ro_Pixmap,
#
style: 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
( server: String, # Typically from DISPLAY environment variable.
xauthentication: Null_Or( xc::Xauthentication ) # Ultimately from ~/.Xauthority.
)
=
{ screen = xc::default_screen_of (xc::open_xsession (server, xauthentication));
widget_id_slot = make_mailslot ();
fun widget_id_loop i
=
{ put_in_mailslot (widget_id_slot, i);
#
widget_id_loop (i+1);
};
is = ii::make_image_imp init_images;
ts = pxc::make_readonly_pixmap_cache (screen, ii::get_image is);
shade_imp = si::make_shade_imp screen;
tilef = pxc::get_ro_pixmap ts;
make_thread "widget_id factory" .{ widget_id_loop 0; };
ROOT_WINDOW
{ id => REF (),
screen,
style => wy::empty_style { screen, tilef },
mktile => tilef,
mkshade => si::get_shades shade_imp,
next_widget_id => fn () = take_from_mailslot widget_id_slot # Gets used (only) in widget::make_widget, in src/lib/x-kit/widget/basic/widget.pkg };
};
fun screen_of (ROOT_WINDOW { screen, ... } ) = screen;
fun xsession_of (ROOT_WINDOW { screen, ... } ) = xc::xsession_of_screen screen;
fun delete_root_window root
=
xc::close_xsession (xsession_of root);
fun same_root (ROOT_WINDOW { id, ... }, ROOT_WINDOW { id=>id', ... } )
=
id == id';
fun shades (ROOT_WINDOW { mkshade, ... } ) c = mkshade c;
fun ro_pixmap (ROOT_WINDOW { mktile, ... } ) s = mktile s;
fun color_of
(ROOT_WINDOW { screen, ... } )
color_spec
=
xc::get_color color_spec;
fun open_font (ROOT_WINDOW { screen, ... } )
=
xc::open_font (xc::xsession_of_screen screen);
fun get_standard_xcursor (ROOT_WINDOW { screen, ... } ) = xc::get_standard_xcursor (xc::xsession_of_screen screen);
fun ring_bell (ROOT_WINDOW { screen, ... } ) = xc::ring_bell (xc::xsession_of_screen screen);
fun size_of_screen (ROOT_WINDOW { screen, ... } ) = xc::size_of_screen screen;
fun mm_size_of_screen (ROOT_WINDOW { screen, ... } ) = xc::mm_size_of_screen screen;
fun depth_of_screen (ROOT_WINDOW { screen, ... } ) = xc::depth_of_screen screen;
fun style_of (ROOT_WINDOW { style, ... } ) = style;
fun is_monochrome (ROOT_WINDOW { screen, ... } )
=
xc::display_class_of_screen screen == xc::STATIC_GRAY and
xc::depth_of_screen screen == 1;
fun style_from_strings (ROOT_WINDOW { screen, mktile, ... }, sl)
=
wy::style_from_strings ( { screen, tilef=>mktile }, 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 = xc::default_screen_of xsession;
stl = xc::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) (ROOT_WINDOW { screen, mktile, ... } )
=
wy::find_named_opt o_db o_nam { screen, tilef=>mktile };
fun style_from_opt_db (ROOT_WINDOW { screen, mktile, ... }, o_db)
=
wy::style_from_opt_db ( { screen, tilef=>mktile }, 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;